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,wsccro,edihcnstr,
1111 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1113 10 format (/'Virtual-chain energies:'//
1114 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1115 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1116 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1117 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1118 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1119 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1120 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1121 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1122 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1123 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1124 & ' (SS bridges & dist. cnstr.)'/
1125 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1126 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1127 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1128 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1129 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1130 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1131 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1132 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1133 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1134 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1135 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1136 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1137 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1138 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1139 & 'ETOT= ',1pE16.6,' (total)')
1142 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1143 & estr,wbond,ebe,wang,
1144 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1146 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1147 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1148 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1150 10 format (/'Virtual-chain energies:'//
1151 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1152 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1153 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1154 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1155 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1156 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1157 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1158 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1159 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1160 & ' (SS bridges & dist. cnstr.)'/
1161 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1162 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1163 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1164 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1165 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1166 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1167 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1168 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1169 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1170 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1171 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1172 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1173 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1174 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1175 & 'ETOT= ',1pE16.6,' (total)')
1179 C-----------------------------------------------------------------------
1180 subroutine elj(evdw)
1182 C This subroutine calculates the interaction energy of nonbonded side chains
1183 C assuming the LJ potential of interaction.
1185 implicit real*8 (a-h,o-z)
1186 include 'DIMENSIONS'
1187 parameter (accur=1.0d-10)
1188 include 'COMMON.GEO'
1189 include 'COMMON.VAR'
1190 include 'COMMON.LOCAL'
1191 include 'COMMON.CHAIN'
1192 include 'COMMON.DERIV'
1193 include 'COMMON.INTERACT'
1194 include 'COMMON.TORSION'
1195 include 'COMMON.SBRIDGE'
1196 include 'COMMON.NAMES'
1197 include 'COMMON.IOUNITS'
1198 include 'COMMON.CONTACTS'
1200 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1202 do i=iatsc_s,iatsc_e
1203 itypi=iabs(itype(i))
1204 if (itypi.eq.ntyp1) cycle
1205 itypi1=iabs(itype(i+1))
1212 C Calculate SC interaction energy.
1214 do iint=1,nint_gr(i)
1215 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1216 cd & 'iend=',iend(i,iint)
1217 do j=istart(i,iint),iend(i,iint)
1218 itypj=iabs(itype(j))
1219 if (itypj.eq.ntyp1) cycle
1223 C Change 12/1/95 to calculate four-body interactions
1224 rij=xj*xj+yj*yj+zj*zj
1226 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1227 eps0ij=eps(itypi,itypj)
1229 C have you changed here?
1233 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1234 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1235 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1236 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1237 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1238 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1241 C Calculate the components of the gradient in DC and X
1243 fac=-rrij*(e1+evdwij)
1248 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1249 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1250 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1251 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1255 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1259 C 12/1/95, revised on 5/20/97
1261 C Calculate the contact function. The ith column of the array JCONT will
1262 C contain the numbers of atoms that make contacts with the atom I (of numbers
1263 C greater than I). The arrays FACONT and GACONT will contain the values of
1264 C the contact function and its derivative.
1266 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1267 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1268 C Uncomment next line, if the correlation interactions are contact function only
1269 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1271 sigij=sigma(itypi,itypj)
1272 r0ij=rs0(itypi,itypj)
1274 C Check whether the SC's are not too far to make a contact.
1277 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1278 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1280 if (fcont.gt.0.0D0) then
1281 C If the SC-SC distance if close to sigma, apply spline.
1282 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1283 cAdam & fcont1,fprimcont1)
1284 cAdam fcont1=1.0d0-fcont1
1285 cAdam if (fcont1.gt.0.0d0) then
1286 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1287 cAdam fcont=fcont*fcont1
1289 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1290 cga eps0ij=1.0d0/dsqrt(eps0ij)
1292 cga gg(k)=gg(k)*eps0ij
1294 cga eps0ij=-evdwij*eps0ij
1295 C Uncomment for AL's type of SC correlation interactions.
1296 cadam eps0ij=-evdwij
1297 num_conti=num_conti+1
1298 jcont(num_conti,i)=j
1299 facont(num_conti,i)=fcont*eps0ij
1300 fprimcont=eps0ij*fprimcont/rij
1302 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1303 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1304 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1305 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1306 gacont(1,num_conti,i)=-fprimcont*xj
1307 gacont(2,num_conti,i)=-fprimcont*yj
1308 gacont(3,num_conti,i)=-fprimcont*zj
1309 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1310 cd write (iout,'(2i3,3f10.5)')
1311 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1317 num_cont(i)=num_conti
1321 gvdwc(j,i)=expon*gvdwc(j,i)
1322 gvdwx(j,i)=expon*gvdwx(j,i)
1325 C******************************************************************************
1329 C To save time, the factor of EXPON has been extracted from ALL components
1330 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1333 C******************************************************************************
1336 C-----------------------------------------------------------------------------
1337 subroutine eljk(evdw)
1339 C This subroutine calculates the interaction energy of nonbonded side chains
1340 C assuming the LJK potential of interaction.
1342 implicit real*8 (a-h,o-z)
1343 include 'DIMENSIONS'
1344 include 'COMMON.GEO'
1345 include 'COMMON.VAR'
1346 include 'COMMON.LOCAL'
1347 include 'COMMON.CHAIN'
1348 include 'COMMON.DERIV'
1349 include 'COMMON.INTERACT'
1350 include 'COMMON.IOUNITS'
1351 include 'COMMON.NAMES'
1354 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1356 do i=iatsc_s,iatsc_e
1357 itypi=iabs(itype(i))
1358 if (itypi.eq.ntyp1) cycle
1359 itypi1=iabs(itype(i+1))
1364 C Calculate SC interaction energy.
1366 do iint=1,nint_gr(i)
1367 do j=istart(i,iint),iend(i,iint)
1368 itypj=iabs(itype(j))
1369 if (itypj.eq.ntyp1) cycle
1373 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1374 fac_augm=rrij**expon
1375 e_augm=augm(itypi,itypj)*fac_augm
1376 r_inv_ij=dsqrt(rrij)
1378 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1379 fac=r_shift_inv**expon
1380 C have you changed here?
1384 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1385 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1386 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1387 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1388 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1389 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1390 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1393 C Calculate the components of the gradient in DC and X
1395 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1400 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1401 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1402 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1403 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1407 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1415 gvdwc(j,i)=expon*gvdwc(j,i)
1416 gvdwx(j,i)=expon*gvdwx(j,i)
1421 C-----------------------------------------------------------------------------
1422 subroutine ebp(evdw)
1424 C This subroutine calculates the interaction energy of nonbonded side chains
1425 C assuming the Berne-Pechukas potential of interaction.
1427 implicit real*8 (a-h,o-z)
1428 include 'DIMENSIONS'
1429 include 'COMMON.GEO'
1430 include 'COMMON.VAR'
1431 include 'COMMON.LOCAL'
1432 include 'COMMON.CHAIN'
1433 include 'COMMON.DERIV'
1434 include 'COMMON.NAMES'
1435 include 'COMMON.INTERACT'
1436 include 'COMMON.IOUNITS'
1437 include 'COMMON.CALC'
1438 common /srutu/ icall
1439 c double precision rrsave(maxdim)
1442 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1444 c if (icall.eq.0) then
1450 do i=iatsc_s,iatsc_e
1451 itypi=iabs(itype(i))
1452 if (itypi.eq.ntyp1) cycle
1453 itypi1=iabs(itype(i+1))
1457 dxi=dc_norm(1,nres+i)
1458 dyi=dc_norm(2,nres+i)
1459 dzi=dc_norm(3,nres+i)
1460 c dsci_inv=dsc_inv(itypi)
1461 dsci_inv=vbld_inv(i+nres)
1463 C Calculate SC interaction energy.
1465 do iint=1,nint_gr(i)
1466 do j=istart(i,iint),iend(i,iint)
1468 itypj=iabs(itype(j))
1469 if (itypj.eq.ntyp1) cycle
1470 c dscj_inv=dsc_inv(itypj)
1471 dscj_inv=vbld_inv(j+nres)
1472 chi1=chi(itypi,itypj)
1473 chi2=chi(itypj,itypi)
1480 alf12=0.5D0*(alf1+alf2)
1481 C For diagnostics only!!!
1494 dxj=dc_norm(1,nres+j)
1495 dyj=dc_norm(2,nres+j)
1496 dzj=dc_norm(3,nres+j)
1497 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1498 cd if (icall.eq.0) then
1504 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1506 C Calculate whole angle-dependent part of epsilon and contributions
1507 C to its derivatives
1508 C have you changed here?
1509 fac=(rrij*sigsq)**expon2
1512 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1513 eps2der=evdwij*eps3rt
1514 eps3der=evdwij*eps2rt
1515 evdwij=evdwij*eps2rt*eps3rt
1518 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1520 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1521 cd & restyp(itypi),i,restyp(itypj),j,
1522 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1523 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1524 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1527 C Calculate gradient components.
1528 e1=e1*eps1*eps2rt**2*eps3rt**2
1529 fac=-expon*(e1+evdwij)
1532 C Calculate radial part of the gradient
1536 C Calculate the angular part of the gradient and sum add the contributions
1537 C to the appropriate components of the Cartesian gradient.
1545 C-----------------------------------------------------------------------------
1546 subroutine egb(evdw)
1548 C This subroutine calculates the interaction energy of nonbonded side chains
1549 C assuming the Gay-Berne potential of interaction.
1551 implicit real*8 (a-h,o-z)
1552 include 'DIMENSIONS'
1553 include 'COMMON.GEO'
1554 include 'COMMON.VAR'
1555 include 'COMMON.LOCAL'
1556 include 'COMMON.CHAIN'
1557 include 'COMMON.DERIV'
1558 include 'COMMON.NAMES'
1559 include 'COMMON.INTERACT'
1560 include 'COMMON.IOUNITS'
1561 include 'COMMON.CALC'
1562 include 'COMMON.CONTROL'
1563 include 'COMMON.SPLITELE'
1564 include 'COMMON.SBRIDGE'
1566 integer xshift,yshift,zshift
1569 ccccc energy_dec=.false.
1570 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1573 c if (icall.eq.0) lprn=.false.
1575 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1576 C we have the original box)
1580 do i=iatsc_s,iatsc_e
1581 itypi=iabs(itype(i))
1582 if (itypi.eq.ntyp1) cycle
1583 itypi1=iabs(itype(i+1))
1587 C Return atom into box, boxxsize is size of box in x dimension
1589 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1590 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1591 C Condition for being inside the proper box
1592 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1593 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1597 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1598 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1599 C Condition for being inside the proper box
1600 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1601 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1605 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1606 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1607 C Condition for being inside the proper box
1608 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1609 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1613 if (xi.lt.0) xi=xi+boxxsize
1615 if (yi.lt.0) yi=yi+boxysize
1617 if (zi.lt.0) zi=zi+boxzsize
1618 C define scaling factor for lipids
1620 C if (positi.le.0) positi=positi+boxzsize
1622 C first for peptide groups
1623 c for each residue check if it is in lipid or lipid water border area
1624 if ((zi.gt.bordlipbot)
1625 &.and.(zi.lt.bordliptop)) then
1626 C the energy transfer exist
1627 if (zi.lt.buflipbot) then
1628 C what fraction I am in
1630 & ((zi-bordlipbot)/lipbufthick)
1631 C lipbufthick is thickenes of lipid buffore
1632 sslipi=sscalelip(fracinbuf)
1633 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1634 elseif (zi.gt.bufliptop) then
1635 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1636 sslipi=sscalelip(fracinbuf)
1637 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1647 C xi=xi+xshift*boxxsize
1648 C yi=yi+yshift*boxysize
1649 C zi=zi+zshift*boxzsize
1651 dxi=dc_norm(1,nres+i)
1652 dyi=dc_norm(2,nres+i)
1653 dzi=dc_norm(3,nres+i)
1654 c dsci_inv=dsc_inv(itypi)
1655 dsci_inv=vbld_inv(i+nres)
1656 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1657 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1659 C Calculate SC interaction energy.
1661 do iint=1,nint_gr(i)
1662 do j=istart(i,iint),iend(i,iint)
1663 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1665 c write(iout,*) "PRZED ZWYKLE", evdwij
1666 call dyn_ssbond_ene(i,j,evdwij)
1667 c write(iout,*) "PO ZWYKLE", evdwij
1670 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1671 & 'evdw',i,j,evdwij,' ss'
1672 C triple bond artifac removal
1673 do k=j+1,iend(i,iint)
1674 C search over all next residues
1675 if (dyn_ss_mask(k)) then
1676 C check if they are cysteins
1677 C write(iout,*) 'k=',k
1679 c write(iout,*) "PRZED TRI", evdwij
1680 evdwij_przed_tri=evdwij
1681 call triple_ssbond_ene(i,j,k,evdwij)
1682 c if(evdwij_przed_tri.ne.evdwij) then
1683 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1686 c write(iout,*) "PO TRI", evdwij
1687 C call the energy function that removes the artifical triple disulfide
1688 C bond the soubroutine is located in ssMD.F
1690 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1691 & 'evdw',i,j,evdwij,'tss'
1692 endif!dyn_ss_mask(k)
1696 itypj=iabs(itype(j))
1697 if (itypj.eq.ntyp1) cycle
1698 c dscj_inv=dsc_inv(itypj)
1699 dscj_inv=vbld_inv(j+nres)
1700 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1701 c & 1.0d0/vbld(j+nres)
1702 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1703 sig0ij=sigma(itypi,itypj)
1704 chi1=chi(itypi,itypj)
1705 chi2=chi(itypj,itypi)
1712 alf12=0.5D0*(alf1+alf2)
1713 C For diagnostics only!!!
1726 C Return atom J into box the original box
1728 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1729 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1730 C Condition for being inside the proper box
1731 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1732 c & (xj.lt.((-0.5d0)*boxxsize))) then
1736 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1737 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1738 C Condition for being inside the proper box
1739 c if ((yj.gt.((0.5d0)*boxysize)).or.
1740 c & (yj.lt.((-0.5d0)*boxysize))) then
1744 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1745 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1746 C Condition for being inside the proper box
1747 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1748 c & (zj.lt.((-0.5d0)*boxzsize))) then
1752 if (xj.lt.0) xj=xj+boxxsize
1754 if (yj.lt.0) yj=yj+boxysize
1756 if (zj.lt.0) zj=zj+boxzsize
1757 if ((zj.gt.bordlipbot)
1758 &.and.(zj.lt.bordliptop)) then
1759 C the energy transfer exist
1760 if (zj.lt.buflipbot) then
1761 C what fraction I am in
1763 & ((zj-bordlipbot)/lipbufthick)
1764 C lipbufthick is thickenes of lipid buffore
1765 sslipj=sscalelip(fracinbuf)
1766 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1767 elseif (zj.gt.bufliptop) then
1768 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1769 sslipj=sscalelip(fracinbuf)
1770 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1779 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1780 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1781 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1782 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1783 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1784 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1785 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1786 C print *,sslipi,sslipj,bordlipbot,zi,zj
1787 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1795 xj=xj_safe+xshift*boxxsize
1796 yj=yj_safe+yshift*boxysize
1797 zj=zj_safe+zshift*boxzsize
1798 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1799 if(dist_temp.lt.dist_init) then
1809 if (subchap.eq.1) then
1818 dxj=dc_norm(1,nres+j)
1819 dyj=dc_norm(2,nres+j)
1820 dzj=dc_norm(3,nres+j)
1824 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1825 c write (iout,*) "j",j," dc_norm",
1826 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1827 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1829 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1830 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1832 c write (iout,'(a7,4f8.3)')
1833 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1834 if (sss.gt.0.0d0) then
1835 C Calculate angle-dependent terms of energy and contributions to their
1839 sig=sig0ij*dsqrt(sigsq)
1840 rij_shift=1.0D0/rij-sig+sig0ij
1841 c for diagnostics; uncomment
1842 c rij_shift=1.2*sig0ij
1843 C I hate to put IF's in the loops, but here don't have another choice!!!!
1844 if (rij_shift.le.0.0D0) then
1846 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1847 cd & restyp(itypi),i,restyp(itypj),j,
1848 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1852 c---------------------------------------------------------------
1853 rij_shift=1.0D0/rij_shift
1854 fac=rij_shift**expon
1855 C here to start with
1860 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1861 eps2der=evdwij*eps3rt
1862 eps3der=evdwij*eps2rt
1863 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1864 C &((sslipi+sslipj)/2.0d0+
1865 C &(2.0d0-sslipi-sslipj)/2.0d0)
1866 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1867 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1868 evdwij=evdwij*eps2rt*eps3rt
1869 evdw=evdw+evdwij*sss
1871 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1873 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1874 & restyp(itypi),i,restyp(itypj),j,
1875 & epsi,sigm,chi1,chi2,chip1,chip2,
1876 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1877 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1881 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1884 C Calculate gradient components.
1885 e1=e1*eps1*eps2rt**2*eps3rt**2
1886 fac=-expon*(e1+evdwij)*rij_shift
1889 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1890 c & evdwij,fac,sigma(itypi,itypj),expon
1891 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1893 C Calculate the radial part of the gradient
1894 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1895 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1896 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1897 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1898 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1899 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1905 C Calculate angular part of the gradient.
1915 c write (iout,*) "Number of loop steps in EGB:",ind
1916 cccc energy_dec=.false.
1919 C-----------------------------------------------------------------------------
1920 subroutine egbv(evdw)
1922 C This subroutine calculates the interaction energy of nonbonded side chains
1923 C assuming the Gay-Berne-Vorobjev potential of interaction.
1925 implicit real*8 (a-h,o-z)
1926 include 'DIMENSIONS'
1927 include 'COMMON.GEO'
1928 include 'COMMON.VAR'
1929 include 'COMMON.LOCAL'
1930 include 'COMMON.CHAIN'
1931 include 'COMMON.DERIV'
1932 include 'COMMON.NAMES'
1933 include 'COMMON.INTERACT'
1934 include 'COMMON.IOUNITS'
1935 include 'COMMON.CALC'
1936 common /srutu/ icall
1939 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1942 c if (icall.eq.0) lprn=.true.
1944 do i=iatsc_s,iatsc_e
1945 itypi=iabs(itype(i))
1946 if (itypi.eq.ntyp1) cycle
1947 itypi1=iabs(itype(i+1))
1952 if (xi.lt.0) xi=xi+boxxsize
1954 if (yi.lt.0) yi=yi+boxysize
1956 if (zi.lt.0) zi=zi+boxzsize
1957 C define scaling factor for lipids
1959 C if (positi.le.0) positi=positi+boxzsize
1961 C first for peptide groups
1962 c for each residue check if it is in lipid or lipid water border area
1963 if ((zi.gt.bordlipbot)
1964 &.and.(zi.lt.bordliptop)) then
1965 C the energy transfer exist
1966 if (zi.lt.buflipbot) then
1967 C what fraction I am in
1969 & ((zi-bordlipbot)/lipbufthick)
1970 C lipbufthick is thickenes of lipid buffore
1971 sslipi=sscalelip(fracinbuf)
1972 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1973 elseif (zi.gt.bufliptop) then
1974 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1975 sslipi=sscalelip(fracinbuf)
1976 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1986 dxi=dc_norm(1,nres+i)
1987 dyi=dc_norm(2,nres+i)
1988 dzi=dc_norm(3,nres+i)
1989 c dsci_inv=dsc_inv(itypi)
1990 dsci_inv=vbld_inv(i+nres)
1992 C Calculate SC interaction energy.
1994 do iint=1,nint_gr(i)
1995 do j=istart(i,iint),iend(i,iint)
1997 itypj=iabs(itype(j))
1998 if (itypj.eq.ntyp1) cycle
1999 c dscj_inv=dsc_inv(itypj)
2000 dscj_inv=vbld_inv(j+nres)
2001 sig0ij=sigma(itypi,itypj)
2002 r0ij=r0(itypi,itypj)
2003 chi1=chi(itypi,itypj)
2004 chi2=chi(itypj,itypi)
2011 alf12=0.5D0*(alf1+alf2)
2012 C For diagnostics only!!!
2026 if (xj.lt.0) xj=xj+boxxsize
2028 if (yj.lt.0) yj=yj+boxysize
2030 if (zj.lt.0) zj=zj+boxzsize
2031 if ((zj.gt.bordlipbot)
2032 &.and.(zj.lt.bordliptop)) then
2033 C the energy transfer exist
2034 if (zj.lt.buflipbot) then
2035 C what fraction I am in
2037 & ((zj-bordlipbot)/lipbufthick)
2038 C lipbufthick is thickenes of lipid buffore
2039 sslipj=sscalelip(fracinbuf)
2040 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
2041 elseif (zj.gt.bufliptop) then
2042 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
2043 sslipj=sscalelip(fracinbuf)
2044 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
2053 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
2054 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2055 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
2056 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2057 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
2058 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
2059 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2067 xj=xj_safe+xshift*boxxsize
2068 yj=yj_safe+yshift*boxysize
2069 zj=zj_safe+zshift*boxzsize
2070 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2071 if(dist_temp.lt.dist_init) then
2081 if (subchap.eq.1) then
2090 dxj=dc_norm(1,nres+j)
2091 dyj=dc_norm(2,nres+j)
2092 dzj=dc_norm(3,nres+j)
2093 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2095 C Calculate angle-dependent terms of energy and contributions to their
2099 sig=sig0ij*dsqrt(sigsq)
2100 rij_shift=1.0D0/rij-sig+r0ij
2101 C I hate to put IF's in the loops, but here don't have another choice!!!!
2102 if (rij_shift.le.0.0D0) then
2107 c---------------------------------------------------------------
2108 rij_shift=1.0D0/rij_shift
2109 fac=rij_shift**expon
2112 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2113 eps2der=evdwij*eps3rt
2114 eps3der=evdwij*eps2rt
2115 fac_augm=rrij**expon
2116 e_augm=augm(itypi,itypj)*fac_augm
2117 evdwij=evdwij*eps2rt*eps3rt
2118 evdw=evdw+evdwij+e_augm
2120 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2122 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2123 & restyp(itypi),i,restyp(itypj),j,
2124 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2125 & chi1,chi2,chip1,chip2,
2126 & eps1,eps2rt**2,eps3rt**2,
2127 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2130 C Calculate gradient components.
2131 e1=e1*eps1*eps2rt**2*eps3rt**2
2132 fac=-expon*(e1+evdwij)*rij_shift
2134 fac=rij*fac-2*expon*rrij*e_augm
2135 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2136 C Calculate the radial part of the gradient
2140 C Calculate angular part of the gradient.
2146 C-----------------------------------------------------------------------------
2147 subroutine sc_angular
2148 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2149 C om12. Called by ebp, egb, and egbv.
2151 include 'COMMON.CALC'
2152 include 'COMMON.IOUNITS'
2156 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2157 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2158 om12=dxi*dxj+dyi*dyj+dzi*dzj
2160 C Calculate eps1(om12) and its derivative in om12
2161 faceps1=1.0D0-om12*chiom12
2162 faceps1_inv=1.0D0/faceps1
2163 eps1=dsqrt(faceps1_inv)
2164 C Following variable is eps1*deps1/dom12
2165 eps1_om12=faceps1_inv*chiom12
2170 c write (iout,*) "om12",om12," eps1",eps1
2171 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2176 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2177 sigsq=1.0D0-facsig*faceps1_inv
2178 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2179 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2180 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2186 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2187 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2189 C Calculate eps2 and its derivatives in om1, om2, and om12.
2192 chipom12=chip12*om12
2193 facp=1.0D0-om12*chipom12
2195 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2196 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2197 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2198 C Following variable is the square root of eps2
2199 eps2rt=1.0D0-facp1*facp_inv
2200 C Following three variables are the derivatives of the square root of eps
2201 C in om1, om2, and om12.
2202 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2203 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2204 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2205 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2206 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2207 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2208 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2209 c & " eps2rt_om12",eps2rt_om12
2210 C Calculate whole angle-dependent part of epsilon and contributions
2211 C to its derivatives
2214 C----------------------------------------------------------------------------
2216 implicit real*8 (a-h,o-z)
2217 include 'DIMENSIONS'
2218 include 'COMMON.CHAIN'
2219 include 'COMMON.DERIV'
2220 include 'COMMON.CALC'
2221 include 'COMMON.IOUNITS'
2222 double precision dcosom1(3),dcosom2(3)
2223 cc print *,'sss=',sss
2224 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2225 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2226 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2227 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2231 c eom12=evdwij*eps1_om12
2233 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2234 c & " sigder",sigder
2235 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2236 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2238 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2239 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2242 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2244 c write (iout,*) "gg",(gg(k),k=1,3)
2246 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2247 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2248 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2249 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2250 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2251 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2252 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2253 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2254 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2255 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2258 C Calculate the components of the gradient in DC and X
2262 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2266 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2267 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2271 C-----------------------------------------------------------------------
2272 subroutine e_softsphere(evdw)
2274 C This subroutine calculates the interaction energy of nonbonded side chains
2275 C assuming the LJ potential of interaction.
2277 implicit real*8 (a-h,o-z)
2278 include 'DIMENSIONS'
2279 parameter (accur=1.0d-10)
2280 include 'COMMON.GEO'
2281 include 'COMMON.VAR'
2282 include 'COMMON.LOCAL'
2283 include 'COMMON.CHAIN'
2284 include 'COMMON.DERIV'
2285 include 'COMMON.INTERACT'
2286 include 'COMMON.TORSION'
2287 include 'COMMON.SBRIDGE'
2288 include 'COMMON.NAMES'
2289 include 'COMMON.IOUNITS'
2290 include 'COMMON.CONTACTS'
2292 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2294 do i=iatsc_s,iatsc_e
2295 itypi=iabs(itype(i))
2296 if (itypi.eq.ntyp1) cycle
2297 itypi1=iabs(itype(i+1))
2302 C Calculate SC interaction energy.
2304 do iint=1,nint_gr(i)
2305 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2306 cd & 'iend=',iend(i,iint)
2307 do j=istart(i,iint),iend(i,iint)
2308 itypj=iabs(itype(j))
2309 if (itypj.eq.ntyp1) cycle
2313 rij=xj*xj+yj*yj+zj*zj
2314 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2315 r0ij=r0(itypi,itypj)
2317 c print *,i,j,r0ij,dsqrt(rij)
2318 if (rij.lt.r0ijsq) then
2319 evdwij=0.25d0*(rij-r0ijsq)**2
2327 C Calculate the components of the gradient in DC and X
2333 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2334 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2335 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2336 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2340 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2348 C--------------------------------------------------------------------------
2349 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2352 C Soft-sphere potential of p-p interaction
2354 implicit real*8 (a-h,o-z)
2355 include 'DIMENSIONS'
2356 include 'COMMON.CONTROL'
2357 include 'COMMON.IOUNITS'
2358 include 'COMMON.GEO'
2359 include 'COMMON.VAR'
2360 include 'COMMON.LOCAL'
2361 include 'COMMON.CHAIN'
2362 include 'COMMON.DERIV'
2363 include 'COMMON.INTERACT'
2364 include 'COMMON.CONTACTS'
2365 include 'COMMON.TORSION'
2366 include 'COMMON.VECTORS'
2367 include 'COMMON.FFIELD'
2369 C write(iout,*) 'In EELEC_soft_sphere'
2376 do i=iatel_s,iatel_e
2377 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2381 xmedi=c(1,i)+0.5d0*dxi
2382 ymedi=c(2,i)+0.5d0*dyi
2383 zmedi=c(3,i)+0.5d0*dzi
2384 xmedi=mod(xmedi,boxxsize)
2385 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2386 ymedi=mod(ymedi,boxysize)
2387 if (ymedi.lt.0) ymedi=ymedi+boxysize
2388 zmedi=mod(zmedi,boxzsize)
2389 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2391 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2392 do j=ielstart(i),ielend(i)
2393 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2397 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2398 r0ij=rpp(iteli,itelj)
2407 if (xj.lt.0) xj=xj+boxxsize
2409 if (yj.lt.0) yj=yj+boxysize
2411 if (zj.lt.0) zj=zj+boxzsize
2412 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2420 xj=xj_safe+xshift*boxxsize
2421 yj=yj_safe+yshift*boxysize
2422 zj=zj_safe+zshift*boxzsize
2423 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2424 if(dist_temp.lt.dist_init) then
2434 if (isubchap.eq.1) then
2443 rij=xj*xj+yj*yj+zj*zj
2444 sss=sscale(sqrt(rij))
2445 sssgrad=sscagrad(sqrt(rij))
2446 if (rij.lt.r0ijsq) then
2447 evdw1ij=0.25d0*(rij-r0ijsq)**2
2453 evdw1=evdw1+evdw1ij*sss
2455 C Calculate contributions to the Cartesian gradient.
2457 ggg(1)=fac*xj*sssgrad
2458 ggg(2)=fac*yj*sssgrad
2459 ggg(3)=fac*zj*sssgrad
2461 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2462 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2465 * Loop over residues i+1 thru j-1.
2469 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2474 cgrad do i=nnt,nct-1
2476 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2478 cgrad do j=i+1,nct-1
2480 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2486 c------------------------------------------------------------------------------
2487 subroutine vec_and_deriv
2488 implicit real*8 (a-h,o-z)
2489 include 'DIMENSIONS'
2493 include 'COMMON.IOUNITS'
2494 include 'COMMON.GEO'
2495 include 'COMMON.VAR'
2496 include 'COMMON.LOCAL'
2497 include 'COMMON.CHAIN'
2498 include 'COMMON.VECTORS'
2499 include 'COMMON.SETUP'
2500 include 'COMMON.TIME1'
2501 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2502 C Compute the local reference systems. For reference system (i), the
2503 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2504 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2506 do i=ivec_start,ivec_end
2510 if (i.eq.nres-1) then
2511 C Case of the last full residue
2512 C Compute the Z-axis
2513 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2514 costh=dcos(pi-theta(nres))
2515 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2519 C Compute the derivatives of uz
2521 uzder(2,1,1)=-dc_norm(3,i-1)
2522 uzder(3,1,1)= dc_norm(2,i-1)
2523 uzder(1,2,1)= dc_norm(3,i-1)
2525 uzder(3,2,1)=-dc_norm(1,i-1)
2526 uzder(1,3,1)=-dc_norm(2,i-1)
2527 uzder(2,3,1)= dc_norm(1,i-1)
2530 uzder(2,1,2)= dc_norm(3,i)
2531 uzder(3,1,2)=-dc_norm(2,i)
2532 uzder(1,2,2)=-dc_norm(3,i)
2534 uzder(3,2,2)= dc_norm(1,i)
2535 uzder(1,3,2)= dc_norm(2,i)
2536 uzder(2,3,2)=-dc_norm(1,i)
2538 C Compute the Y-axis
2541 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2543 C Compute the derivatives of uy
2546 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2547 & -dc_norm(k,i)*dc_norm(j,i-1)
2548 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2550 uyder(j,j,1)=uyder(j,j,1)-costh
2551 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2556 uygrad(l,k,j,i)=uyder(l,k,j)
2557 uzgrad(l,k,j,i)=uzder(l,k,j)
2561 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2562 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2563 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2564 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2567 C Compute the Z-axis
2568 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2569 costh=dcos(pi-theta(i+2))
2570 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2574 C Compute the derivatives of uz
2576 uzder(2,1,1)=-dc_norm(3,i+1)
2577 uzder(3,1,1)= dc_norm(2,i+1)
2578 uzder(1,2,1)= dc_norm(3,i+1)
2580 uzder(3,2,1)=-dc_norm(1,i+1)
2581 uzder(1,3,1)=-dc_norm(2,i+1)
2582 uzder(2,3,1)= dc_norm(1,i+1)
2585 uzder(2,1,2)= dc_norm(3,i)
2586 uzder(3,1,2)=-dc_norm(2,i)
2587 uzder(1,2,2)=-dc_norm(3,i)
2589 uzder(3,2,2)= dc_norm(1,i)
2590 uzder(1,3,2)= dc_norm(2,i)
2591 uzder(2,3,2)=-dc_norm(1,i)
2593 C Compute the Y-axis
2596 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2598 C Compute the derivatives of uy
2601 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2602 & -dc_norm(k,i)*dc_norm(j,i+1)
2603 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2605 uyder(j,j,1)=uyder(j,j,1)-costh
2606 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2611 uygrad(l,k,j,i)=uyder(l,k,j)
2612 uzgrad(l,k,j,i)=uzder(l,k,j)
2616 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2617 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2618 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2619 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2623 vbld_inv_temp(1)=vbld_inv(i+1)
2624 if (i.lt.nres-1) then
2625 vbld_inv_temp(2)=vbld_inv(i+2)
2627 vbld_inv_temp(2)=vbld_inv(i)
2632 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2633 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2638 #if defined(PARVEC) && defined(MPI)
2639 if (nfgtasks1.gt.1) then
2641 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2642 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2643 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2644 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2645 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2647 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2648 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2650 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2651 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2652 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2653 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2654 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2655 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2656 time_gather=time_gather+MPI_Wtime()-time00
2658 c if (fg_rank.eq.0) then
2659 c write (iout,*) "Arrays UY and UZ"
2661 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2668 C-----------------------------------------------------------------------------
2669 subroutine check_vecgrad
2670 implicit real*8 (a-h,o-z)
2671 include 'DIMENSIONS'
2672 include 'COMMON.IOUNITS'
2673 include 'COMMON.GEO'
2674 include 'COMMON.VAR'
2675 include 'COMMON.LOCAL'
2676 include 'COMMON.CHAIN'
2677 include 'COMMON.VECTORS'
2678 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2679 dimension uyt(3,maxres),uzt(3,maxres)
2680 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2681 double precision delta /1.0d-7/
2684 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2685 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2686 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2687 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2688 cd & (dc_norm(if90,i),if90=1,3)
2689 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2690 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2691 cd write(iout,'(a)')
2697 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2698 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2711 cd write (iout,*) 'i=',i
2713 erij(k)=dc_norm(k,i)
2717 dc_norm(k,i)=erij(k)
2719 dc_norm(j,i)=dc_norm(j,i)+delta
2720 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2722 c dc_norm(k,i)=dc_norm(k,i)/fac
2724 c write (iout,*) (dc_norm(k,i),k=1,3)
2725 c write (iout,*) (erij(k),k=1,3)
2728 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2729 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2730 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2731 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2733 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2734 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2735 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2738 dc_norm(k,i)=erij(k)
2741 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2742 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2743 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2744 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2745 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2746 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2747 cd write (iout,'(a)')
2752 C--------------------------------------------------------------------------
2753 subroutine set_matrices
2754 implicit real*8 (a-h,o-z)
2755 include 'DIMENSIONS'
2758 include "COMMON.SETUP"
2760 integer status(MPI_STATUS_SIZE)
2762 include 'COMMON.IOUNITS'
2763 include 'COMMON.GEO'
2764 include 'COMMON.VAR'
2765 include 'COMMON.LOCAL'
2766 include 'COMMON.CHAIN'
2767 include 'COMMON.DERIV'
2768 include 'COMMON.INTERACT'
2769 include 'COMMON.CONTACTS'
2770 include 'COMMON.TORSION'
2771 include 'COMMON.VECTORS'
2772 include 'COMMON.FFIELD'
2773 double precision auxvec(2),auxmat(2,2)
2775 C Compute the virtual-bond-torsional-angle dependent quantities needed
2776 C to calculate the el-loc multibody terms of various order.
2778 c write(iout,*) 'nphi=',nphi,nres
2780 do i=ivec_start+2,ivec_end+2
2785 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2786 iti = itype2loc(itype(i-2))
2790 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2791 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2792 iti1 = itype2loc(itype(i-1))
2797 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0d0)
2798 & +bnew1(2,1,iti)*dsin(theta(i-1))
2799 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0d0)
2800 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2801 & +bnew1(2,1,iti)*dcos(theta(i-1))
2802 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2803 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2804 c &*(cos(theta(i)/2.0)
2805 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0d0)
2806 & +bnew2(2,1,iti)*dsin(theta(i-1))
2807 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0d0)
2808 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2809 c &*(cos(theta(i)/2.0)
2810 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2811 & +bnew2(2,1,iti)*dcos(theta(i-1))
2812 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2813 c if (ggb1(1,i).eq.0.0d0) then
2814 c write(iout,*) 'i=',i,ggb1(1,i),
2815 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2816 c &bnew1(2,1,iti)*cos(theta(i)),
2817 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2819 b1(2,i-2)=bnew1(1,2,iti)
2821 b2(2,i-2)=bnew2(1,2,iti)
2823 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2824 EE(1,2,i-2)=eeold(1,2,iti)
2825 EE(2,1,i-2)=eeold(2,1,iti)
2826 EE(2,2,i-2)=eeold(2,2,iti)
2827 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2832 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2833 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2834 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2835 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2836 b1tilde(1,i-2)=b1(1,i-2)
2837 b1tilde(2,i-2)=-b1(2,i-2)
2838 b2tilde(1,i-2)=b2(1,i-2)
2839 b2tilde(2,i-2)=-b2(2,i-2)
2840 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2841 c write(iout,*) 'b1=',b1(1,i-2)
2842 c write (iout,*) 'theta=', theta(i-1)
2845 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2846 iti = itype2loc(itype(i-2))
2850 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2851 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2852 iti1 = itype2loc(itype(i-1))
2860 b1tilde(1,i-2)=b1(1,i-2)
2861 b1tilde(2,i-2)=-b1(2,i-2)
2862 b2tilde(1,i-2)=b2(1,i-2)
2863 b2tilde(2,i-2)=-b2(2,i-2)
2864 EE(1,2,i-2)=eeold(1,2,iti)
2865 EE(2,1,i-2)=eeold(2,1,iti)
2866 EE(2,2,i-2)=eeold(2,2,iti)
2867 EE(1,1,i-2)=eeold(1,1,iti)
2871 do i=ivec_start+2,ivec_end+2
2875 if (i .lt. nres+1) then
2912 if (i .gt. 3 .and. i .lt. nres+1) then
2913 obrot_der(1,i-2)=-sin1
2914 obrot_der(2,i-2)= cos1
2915 Ugder(1,1,i-2)= sin1
2916 Ugder(1,2,i-2)=-cos1
2917 Ugder(2,1,i-2)=-cos1
2918 Ugder(2,2,i-2)=-sin1
2921 obrot2_der(1,i-2)=-dwasin2
2922 obrot2_der(2,i-2)= dwacos2
2923 Ug2der(1,1,i-2)= dwasin2
2924 Ug2der(1,2,i-2)=-dwacos2
2925 Ug2der(2,1,i-2)=-dwacos2
2926 Ug2der(2,2,i-2)=-dwasin2
2928 obrot_der(1,i-2)=0.0d0
2929 obrot_der(2,i-2)=0.0d0
2930 Ugder(1,1,i-2)=0.0d0
2931 Ugder(1,2,i-2)=0.0d0
2932 Ugder(2,1,i-2)=0.0d0
2933 Ugder(2,2,i-2)=0.0d0
2934 obrot2_der(1,i-2)=0.0d0
2935 obrot2_der(2,i-2)=0.0d0
2936 Ug2der(1,1,i-2)=0.0d0
2937 Ug2der(1,2,i-2)=0.0d0
2938 Ug2der(2,1,i-2)=0.0d0
2939 Ug2der(2,2,i-2)=0.0d0
2941 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2942 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2943 iti = itype2loc(itype(i-2))
2947 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2948 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2949 iti1 = itype2loc(itype(i-1))
2953 cd write (iout,*) '*******i',i,' iti1',iti
2954 cd write (iout,*) 'b1',b1(:,iti)
2955 cd write (iout,*) 'b2',b2(:,iti)
2956 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2957 c if (i .gt. iatel_s+2) then
2958 if (i .gt. nnt+2) then
2959 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2961 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2962 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2964 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
2965 c & EE(1,2,iti),EE(2,2,i)
2966 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2967 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2968 c write(iout,*) "Macierz EUG",
2969 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2971 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2973 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2974 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2975 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2976 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2977 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2988 DtUg2(l,k,i-2)=0.0d0
2992 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2993 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2995 muder(k,i-2)=Ub2der(k,i-2)
2997 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2998 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2999 if (itype(i-1).le.ntyp) then
3000 iti1 = itype2loc(itype(i-1))
3008 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
3011 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
3012 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
3013 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
3014 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
3015 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
3016 & ((ee(l,k,i-2),l=1,2),k=1,2),eenew(1,itype2loc(iti))
3018 cd write (iout,*) 'mu1',mu1(:,i-2)
3019 cd write (iout,*) 'mu2',mu2(:,i-2)
3020 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3022 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3023 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
3024 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3025 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
3026 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3027 C Vectors and matrices dependent on a single virtual-bond dihedral.
3028 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
3029 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3030 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3031 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
3032 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
3033 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3034 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3035 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3036 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3039 C Matrices dependent on two consecutive virtual-bond dihedrals.
3040 C The order of matrices is from left to right.
3041 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3043 c do i=max0(ivec_start,2),ivec_end
3045 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3046 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3047 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3048 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3049 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3050 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3051 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3052 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3055 #if defined(MPI) && defined(PARMAT)
3057 c if (fg_rank.eq.0) then
3058 write (iout,*) "Arrays UG and UGDER before GATHER"
3060 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3061 & ((ug(l,k,i),l=1,2),k=1,2),
3062 & ((ugder(l,k,i),l=1,2),k=1,2)
3064 write (iout,*) "Arrays UG2 and UG2DER"
3066 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3067 & ((ug2(l,k,i),l=1,2),k=1,2),
3068 & ((ug2der(l,k,i),l=1,2),k=1,2)
3070 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3072 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3073 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3074 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3076 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3078 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3079 & costab(i),sintab(i),costab2(i),sintab2(i)
3081 write (iout,*) "Array MUDER"
3083 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3087 if (nfgtasks.gt.1) then
3089 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
3090 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
3091 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
3093 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
3094 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3096 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
3097 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3099 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
3100 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3102 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
3103 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3105 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
3106 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3108 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
3109 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3111 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
3112 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
3113 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3114 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
3115 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
3116 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3117 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
3118 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
3119 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3120 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
3121 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
3122 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3123 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3125 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
3126 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3128 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
3129 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3131 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
3132 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3134 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3135 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3137 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3138 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3140 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3141 & ivec_count(fg_rank1),
3142 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3144 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3145 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3147 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3148 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3150 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3151 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3153 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3154 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3156 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3157 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3159 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3160 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3162 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3163 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3165 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3166 & ivec_count(fg_rank1),
3167 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3169 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3170 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3172 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3173 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3175 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3176 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3178 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3179 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3181 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3182 & ivec_count(fg_rank1),
3183 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3185 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3186 & ivec_count(fg_rank1),
3187 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3189 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3190 & ivec_count(fg_rank1),
3191 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3192 & MPI_MAT2,FG_COMM1,IERR)
3193 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3194 & ivec_count(fg_rank1),
3195 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3196 & MPI_MAT2,FG_COMM1,IERR)
3199 c Passes matrix info through the ring
3202 if (irecv.lt.0) irecv=nfgtasks1-1
3205 if (inext.ge.nfgtasks1) inext=0
3207 c write (iout,*) "isend",isend," irecv",irecv
3209 lensend=lentyp(isend)
3210 lenrecv=lentyp(irecv)
3211 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3212 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3213 c & MPI_ROTAT1(lensend),inext,2200+isend,
3214 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3215 c & iprev,2200+irecv,FG_COMM,status,IERR)
3216 c write (iout,*) "Gather ROTAT1"
3218 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3219 c & MPI_ROTAT2(lensend),inext,3300+isend,
3220 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3221 c & iprev,3300+irecv,FG_COMM,status,IERR)
3222 c write (iout,*) "Gather ROTAT2"
3224 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3225 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3226 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3227 & iprev,4400+irecv,FG_COMM,status,IERR)
3228 c write (iout,*) "Gather ROTAT_OLD"
3230 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3231 & MPI_PRECOMP11(lensend),inext,5500+isend,
3232 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3233 & iprev,5500+irecv,FG_COMM,status,IERR)
3234 c write (iout,*) "Gather PRECOMP11"
3236 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3237 & MPI_PRECOMP12(lensend),inext,6600+isend,
3238 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3239 & iprev,6600+irecv,FG_COMM,status,IERR)
3240 c write (iout,*) "Gather PRECOMP12"
3242 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3244 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3245 & MPI_ROTAT2(lensend),inext,7700+isend,
3246 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3247 & iprev,7700+irecv,FG_COMM,status,IERR)
3248 c write (iout,*) "Gather PRECOMP21"
3250 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3251 & MPI_PRECOMP22(lensend),inext,8800+isend,
3252 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3253 & iprev,8800+irecv,FG_COMM,status,IERR)
3254 c write (iout,*) "Gather PRECOMP22"
3256 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3257 & MPI_PRECOMP23(lensend),inext,9900+isend,
3258 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3259 & MPI_PRECOMP23(lenrecv),
3260 & iprev,9900+irecv,FG_COMM,status,IERR)
3261 c write (iout,*) "Gather PRECOMP23"
3266 if (irecv.lt.0) irecv=nfgtasks1-1
3269 time_gather=time_gather+MPI_Wtime()-time00
3272 c if (fg_rank.eq.0) then
3273 write (iout,*) "Arrays UG and UGDER"
3275 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3276 & ((ug(l,k,i),l=1,2),k=1,2),
3277 & ((ugder(l,k,i),l=1,2),k=1,2)
3279 write (iout,*) "Arrays UG2 and UG2DER"
3281 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3282 & ((ug2(l,k,i),l=1,2),k=1,2),
3283 & ((ug2der(l,k,i),l=1,2),k=1,2)
3285 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3287 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3288 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3289 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3291 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3293 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3294 & costab(i),sintab(i),costab2(i),sintab2(i)
3296 write (iout,*) "Array MUDER"
3298 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3304 cd iti = itype2loc(itype(i))
3307 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3308 cd & (EE(j,k,i),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3313 C--------------------------------------------------------------------------
3314 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3316 C This subroutine calculates the average interaction energy and its gradient
3317 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3318 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3319 C The potential depends both on the distance of peptide-group centers and on
3320 C the orientation of the CA-CA virtual bonds.
3322 implicit real*8 (a-h,o-z)
3326 include 'DIMENSIONS'
3327 include 'COMMON.CONTROL'
3328 include 'COMMON.SETUP'
3329 include 'COMMON.IOUNITS'
3330 include 'COMMON.GEO'
3331 include 'COMMON.VAR'
3332 include 'COMMON.LOCAL'
3333 include 'COMMON.CHAIN'
3334 include 'COMMON.DERIV'
3335 include 'COMMON.INTERACT'
3336 include 'COMMON.CONTACTS'
3337 include 'COMMON.TORSION'
3338 include 'COMMON.VECTORS'
3339 include 'COMMON.FFIELD'
3340 include 'COMMON.TIME1'
3341 include 'COMMON.SPLITELE'
3342 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3343 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3344 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3345 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3346 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3347 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3349 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3351 double precision scal_el /1.0d0/
3353 double precision scal_el /0.5d0/
3356 C 13-go grudnia roku pamietnego...
3357 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3358 & 0.0d0,1.0d0,0.0d0,
3359 & 0.0d0,0.0d0,1.0d0/
3360 cd write(iout,*) 'In EELEC'
3362 cd write(iout,*) 'Type',i
3363 cd write(iout,*) 'B1',B1(:,i)
3364 cd write(iout,*) 'B2',B2(:,i)
3365 cd write(iout,*) 'CC',CC(:,:,i)
3366 cd write(iout,*) 'DD',DD(:,:,i)
3367 cd write(iout,*) 'EE',EE(:,:,i)
3369 cd call check_vecgrad
3371 if (icheckgrad.eq.1) then
3373 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3375 dc_norm(k,i)=dc(k,i)*fac
3377 c write (iout,*) 'i',i,' fac',fac
3380 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3381 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3382 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3383 c call vec_and_deriv
3389 time_mat=time_mat+MPI_Wtime()-time01
3393 cd write (iout,*) 'i=',i
3395 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3398 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3399 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3412 cd print '(a)','Enter EELEC'
3413 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3415 gel_loc_loc(i)=0.0d0
3420 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3422 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3424 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3425 do i=iturn3_start,iturn3_end
3427 C write(iout,*) "tu jest i",i
3428 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3429 C changes suggested by Ana to avoid out of bounds
3430 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
3431 c & .or.((i+4).gt.nres)
3432 c & .or.((i-1).le.0)
3433 C end of changes by Ana
3434 & .or. itype(i+2).eq.ntyp1
3435 & .or. itype(i+3).eq.ntyp1) cycle
3436 C Adam: Instructions below will switch off existing interactions
3438 c if(itype(i-1).eq.ntyp1)cycle
3440 c if(i.LT.nres-3)then
3441 c if (itype(i+4).eq.ntyp1) cycle
3446 dx_normi=dc_norm(1,i)
3447 dy_normi=dc_norm(2,i)
3448 dz_normi=dc_norm(3,i)
3449 xmedi=c(1,i)+0.5d0*dxi
3450 ymedi=c(2,i)+0.5d0*dyi
3451 zmedi=c(3,i)+0.5d0*dzi
3452 xmedi=mod(xmedi,boxxsize)
3453 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3454 ymedi=mod(ymedi,boxysize)
3455 if (ymedi.lt.0) ymedi=ymedi+boxysize
3456 zmedi=mod(zmedi,boxzsize)
3457 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3459 call eelecij(i,i+2,ees,evdw1,eel_loc)
3460 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3461 num_cont_hb(i)=num_conti
3463 do i=iturn4_start,iturn4_end
3465 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3466 C changes suggested by Ana to avoid out of bounds
3467 c & .or.((i+5).gt.nres)
3468 c & .or.((i-1).le.0)
3469 C end of changes suggested by Ana
3470 & .or. itype(i+3).eq.ntyp1
3471 & .or. itype(i+4).eq.ntyp1
3472 c & .or. itype(i+5).eq.ntyp1
3473 c & .or. itype(i).eq.ntyp1
3474 c & .or. itype(i-1).eq.ntyp1
3479 dx_normi=dc_norm(1,i)
3480 dy_normi=dc_norm(2,i)
3481 dz_normi=dc_norm(3,i)
3482 xmedi=c(1,i)+0.5d0*dxi
3483 ymedi=c(2,i)+0.5d0*dyi
3484 zmedi=c(3,i)+0.5d0*dzi
3485 C Return atom into box, boxxsize is size of box in x dimension
3487 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3488 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3489 C Condition for being inside the proper box
3490 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3491 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3495 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3496 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3497 C Condition for being inside the proper box
3498 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3499 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3503 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3504 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3505 C Condition for being inside the proper box
3506 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3507 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3510 xmedi=mod(xmedi,boxxsize)
3511 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3512 ymedi=mod(ymedi,boxysize)
3513 if (ymedi.lt.0) ymedi=ymedi+boxysize
3514 zmedi=mod(zmedi,boxzsize)
3515 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3517 num_conti=num_cont_hb(i)
3518 c write(iout,*) "JESTEM W PETLI"
3519 call eelecij(i,i+3,ees,evdw1,eel_loc)
3520 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3521 & call eturn4(i,eello_turn4)
3522 num_cont_hb(i)=num_conti
3524 C Loop over all neighbouring boxes
3529 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3532 do i=iatel_s,iatel_e
3535 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3536 C changes suggested by Ana to avoid out of bounds
3537 c & .or.((i+2).gt.nres)
3538 c & .or.((i-1).le.0)
3539 C end of changes by Ana
3540 c & .or. itype(i+2).eq.ntyp1
3541 c & .or. itype(i-1).eq.ntyp1
3546 dx_normi=dc_norm(1,i)
3547 dy_normi=dc_norm(2,i)
3548 dz_normi=dc_norm(3,i)
3549 xmedi=c(1,i)+0.5d0*dxi
3550 ymedi=c(2,i)+0.5d0*dyi
3551 zmedi=c(3,i)+0.5d0*dzi
3552 xmedi=mod(xmedi,boxxsize)
3553 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3554 ymedi=mod(ymedi,boxysize)
3555 if (ymedi.lt.0) ymedi=ymedi+boxysize
3556 zmedi=mod(zmedi,boxzsize)
3557 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3558 C xmedi=xmedi+xshift*boxxsize
3559 C ymedi=ymedi+yshift*boxysize
3560 C zmedi=zmedi+zshift*boxzsize
3562 C Return tom into box, boxxsize is size of box in x dimension
3564 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3565 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3566 C Condition for being inside the proper box
3567 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3568 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3572 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3573 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3574 C Condition for being inside the proper box
3575 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3576 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3580 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3581 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3582 cC Condition for being inside the proper box
3583 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3584 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3588 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3589 num_conti=num_cont_hb(i)
3591 do j=ielstart(i),ielend(i)
3593 C write (iout,*) i,j
3595 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3596 C changes suggested by Ana to avoid out of bounds
3597 c & .or.((j+2).gt.nres)
3598 c & .or.((j-1).le.0)
3599 C end of changes by Ana
3600 c & .or.itype(j+2).eq.ntyp1
3601 c & .or.itype(j-1).eq.ntyp1
3603 call eelecij(i,j,ees,evdw1,eel_loc)
3605 num_cont_hb(i)=num_conti
3611 c write (iout,*) "Number of loop steps in EELEC:",ind
3613 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3614 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3616 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3617 ccc eel_loc=eel_loc+eello_turn3
3618 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3621 C-------------------------------------------------------------------------------
3622 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3623 implicit real*8 (a-h,o-z)
3624 include 'DIMENSIONS'
3628 include 'COMMON.CONTROL'
3629 include 'COMMON.IOUNITS'
3630 include 'COMMON.GEO'
3631 include 'COMMON.VAR'
3632 include 'COMMON.LOCAL'
3633 include 'COMMON.CHAIN'
3634 include 'COMMON.DERIV'
3635 include 'COMMON.INTERACT'
3636 include 'COMMON.CONTACTS'
3637 include 'COMMON.TORSION'
3638 include 'COMMON.VECTORS'
3639 include 'COMMON.FFIELD'
3640 include 'COMMON.TIME1'
3641 include 'COMMON.SPLITELE'
3642 include 'COMMON.SHIELD'
3643 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3644 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3645 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3646 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3647 & gmuij2(4),gmuji2(4)
3648 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3649 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3651 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3653 double precision scal_el /1.0d0/
3655 double precision scal_el /0.5d0/
3658 C 13-go grudnia roku pamietnego...
3659 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3660 & 0.0d0,1.0d0,0.0d0,
3661 & 0.0d0,0.0d0,1.0d0/
3662 c time00=MPI_Wtime()
3663 cd write (iout,*) "eelecij",i,j
3667 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3668 aaa=app(iteli,itelj)
3669 bbb=bpp(iteli,itelj)
3670 ael6i=ael6(iteli,itelj)
3671 ael3i=ael3(iteli,itelj)
3675 dx_normj=dc_norm(1,j)
3676 dy_normj=dc_norm(2,j)
3677 dz_normj=dc_norm(3,j)
3678 C xj=c(1,j)+0.5D0*dxj-xmedi
3679 C yj=c(2,j)+0.5D0*dyj-ymedi
3680 C zj=c(3,j)+0.5D0*dzj-zmedi
3685 if (xj.lt.0) xj=xj+boxxsize
3687 if (yj.lt.0) yj=yj+boxysize
3689 if (zj.lt.0) zj=zj+boxzsize
3690 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3691 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3699 xj=xj_safe+xshift*boxxsize
3700 yj=yj_safe+yshift*boxysize
3701 zj=zj_safe+zshift*boxzsize
3702 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3703 if(dist_temp.lt.dist_init) then
3713 if (isubchap.eq.1) then
3722 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3724 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3725 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3726 C Condition for being inside the proper box
3727 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3728 c & (xj.lt.((-0.5d0)*boxxsize))) then
3732 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3733 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3734 C Condition for being inside the proper box
3735 c if ((yj.gt.((0.5d0)*boxysize)).or.
3736 c & (yj.lt.((-0.5d0)*boxysize))) then
3740 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3741 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3742 C Condition for being inside the proper box
3743 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3744 c & (zj.lt.((-0.5d0)*boxzsize))) then
3747 C endif !endPBC condintion
3751 rij=xj*xj+yj*yj+zj*zj
3753 sss=sscale(sqrt(rij))
3754 sssgrad=sscagrad(sqrt(rij))
3755 c if (sss.gt.0.0d0) then
3761 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3762 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3763 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3764 fac=cosa-3.0D0*cosb*cosg
3766 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3767 if (j.eq.i+2) ev1=scal_el*ev1
3772 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3776 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3777 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3778 if (shield_mode.gt.0) then
3781 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3782 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3791 evdw1=evdw1+evdwij*sss
3792 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3793 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3794 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3795 cd & xmedi,ymedi,zmedi,xj,yj,zj
3797 if (energy_dec) then
3798 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3800 &,iteli,itelj,aaa,evdw1
3801 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
3802 &fac_shield(i),fac_shield(j)
3806 C Calculate contributions to the Cartesian gradient.
3809 facvdw=-6*rrmij*(ev1+evdwij)*sss
3810 facel=-3*rrmij*(el1+eesij)
3817 * Radial derivatives. First process both termini of the fragment (i,j)
3822 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3823 & (shield_mode.gt.0)) then
3825 do ilist=1,ishield_list(i)
3826 iresshield=shield_list(ilist,i)
3828 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
3830 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3832 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
3833 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3834 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3835 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3836 C if (iresshield.gt.i) then
3837 C do ishi=i+1,iresshield-1
3838 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3839 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3843 C do ishi=iresshield,i
3844 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3845 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3851 do ilist=1,ishield_list(j)
3852 iresshield=shield_list(ilist,j)
3854 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
3856 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3858 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
3859 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3861 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3862 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3863 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3864 C if (iresshield.gt.j) then
3865 C do ishi=j+1,iresshield-1
3866 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3867 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3871 C do ishi=iresshield,j
3872 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3873 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3880 gshieldc(k,i)=gshieldc(k,i)+
3881 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
3882 gshieldc(k,j)=gshieldc(k,j)+
3883 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
3884 gshieldc(k,i-1)=gshieldc(k,i-1)+
3885 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
3886 gshieldc(k,j-1)=gshieldc(k,j-1)+
3887 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
3892 c ghalf=0.5D0*ggg(k)
3893 c gelc(k,i)=gelc(k,i)+ghalf
3894 c gelc(k,j)=gelc(k,j)+ghalf
3896 c 9/28/08 AL Gradient compotents will be summed only at the end
3897 C print *,"before", gelc_long(1,i), gelc_long(1,j)
3899 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3900 C & +grad_shield(k,j)*eesij/fac_shield(j)
3901 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3902 C & +grad_shield(k,i)*eesij/fac_shield(i)
3903 C gelc_long(k,i-1)=gelc_long(k,i-1)
3904 C & +grad_shield(k,i)*eesij/fac_shield(i)
3905 C gelc_long(k,j-1)=gelc_long(k,j-1)
3906 C & +grad_shield(k,j)*eesij/fac_shield(j)
3908 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
3911 * Loop over residues i+1 thru j-1.
3915 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3918 if (sss.gt.0.0) then
3919 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3920 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3921 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3928 c ghalf=0.5D0*ggg(k)
3929 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3930 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3932 c 9/28/08 AL Gradient compotents will be summed only at the end
3934 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3935 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3938 * Loop over residues i+1 thru j-1.
3942 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3947 facvdw=(ev1+evdwij)*sss
3950 fac=-3*rrmij*(facvdw+facvdw+facel)
3955 * Radial derivatives. First process both termini of the fragment (i,j)
3958 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
3960 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
3962 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
3964 c ghalf=0.5D0*ggg(k)
3965 c gelc(k,i)=gelc(k,i)+ghalf
3966 c gelc(k,j)=gelc(k,j)+ghalf
3968 c 9/28/08 AL Gradient compotents will be summed only at the end
3970 gelc_long(k,j)=gelc(k,j)+ggg(k)
3971 gelc_long(k,i)=gelc(k,i)-ggg(k)
3974 * Loop over residues i+1 thru j-1.
3978 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3981 c 9/28/08 AL Gradient compotents will be summed only at the end
3982 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3983 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3984 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3986 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3987 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3993 ecosa=2.0D0*fac3*fac1+fac4
3996 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3997 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3999 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4000 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4002 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
4003 cd & (dcosg(k),k=1,3)
4005 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
4006 & fac_shield(i)**2*fac_shield(j)**2
4009 c ghalf=0.5D0*ggg(k)
4010 c gelc(k,i)=gelc(k,i)+ghalf
4011 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4012 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4013 c gelc(k,j)=gelc(k,j)+ghalf
4014 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4015 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4019 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4022 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
4025 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4026 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
4027 & *fac_shield(i)**2*fac_shield(j)**2
4029 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4030 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
4031 & *fac_shield(i)**2*fac_shield(j)**2
4032 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4033 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4035 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
4039 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
4040 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
4041 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4043 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
4044 C energy of a peptide unit is assumed in the form of a second-order
4045 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
4046 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
4047 C are computed for EVERY pair of non-contiguous peptide groups.
4050 if (j.lt.nres-1) then
4062 muij(kkk)=mu(k,i)*mu(l,j)
4063 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
4065 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
4066 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
4067 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
4068 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
4069 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
4070 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4074 cd write (iout,*) 'EELEC: i',i,' j',j
4075 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
4076 cd write(iout,*) 'muij',muij
4077 ury=scalar(uy(1,i),erij)
4078 urz=scalar(uz(1,i),erij)
4079 vry=scalar(uy(1,j),erij)
4080 vrz=scalar(uz(1,j),erij)
4081 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4082 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4083 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4084 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4085 fac=dsqrt(-ael6i)*r3ij
4090 cd write (iout,'(4i5,4f10.5)')
4091 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
4092 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4093 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4094 cd & uy(:,j),uz(:,j)
4095 cd write (iout,'(4f10.5)')
4096 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4097 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4098 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
4099 cd write (iout,'(9f10.5/)')
4100 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4101 C Derivatives of the elements of A in virtual-bond vectors
4102 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4104 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4105 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4106 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4107 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4108 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4109 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4110 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4111 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4112 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4113 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4114 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4115 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4117 C Compute radial contributions to the gradient
4135 C Add the contributions coming from er
4138 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4139 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4140 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4141 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4144 C Derivatives in DC(i)
4145 cgrad ghalf1=0.5d0*agg(k,1)
4146 cgrad ghalf2=0.5d0*agg(k,2)
4147 cgrad ghalf3=0.5d0*agg(k,3)
4148 cgrad ghalf4=0.5d0*agg(k,4)
4149 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
4150 & -3.0d0*uryg(k,2)*vry)!+ghalf1
4151 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
4152 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
4153 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
4154 & -3.0d0*urzg(k,2)*vry)!+ghalf3
4155 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
4156 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
4157 C Derivatives in DC(i+1)
4158 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
4159 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4160 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
4161 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4162 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
4163 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4164 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
4165 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4166 C Derivatives in DC(j)
4167 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
4168 & -3.0d0*vryg(k,2)*ury)!+ghalf1
4169 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4170 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4171 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4172 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4173 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4174 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4175 C Derivatives in DC(j+1) or DC(nres-1)
4176 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4177 & -3.0d0*vryg(k,3)*ury)
4178 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4179 & -3.0d0*vrzg(k,3)*ury)
4180 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4181 & -3.0d0*vryg(k,3)*urz)
4182 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4183 & -3.0d0*vrzg(k,3)*urz)
4184 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4186 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4199 aggi(k,l)=-aggi(k,l)
4200 aggi1(k,l)=-aggi1(k,l)
4201 aggj(k,l)=-aggj(k,l)
4202 aggj1(k,l)=-aggj1(k,l)
4205 if (j.lt.nres-1) then
4211 aggi(k,l)=-aggi(k,l)
4212 aggi1(k,l)=-aggi1(k,l)
4213 aggj(k,l)=-aggj(k,l)
4214 aggj1(k,l)=-aggj1(k,l)
4225 aggi(k,l)=-aggi(k,l)
4226 aggi1(k,l)=-aggi1(k,l)
4227 aggj(k,l)=-aggj(k,l)
4228 aggj1(k,l)=-aggj1(k,l)
4233 IF (wel_loc.gt.0.0d0) THEN
4234 C Contribution to the local-electrostatic energy coming from the i-j pair
4235 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4237 if (shield_mode.eq.0) then
4244 eel_loc_ij=eel_loc_ij
4245 & *fac_shield(i)*fac_shield(j)
4246 C Now derivative over eel_loc
4247 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4248 & (shield_mode.gt.0)) then
4251 do ilist=1,ishield_list(i)
4252 iresshield=shield_list(ilist,i)
4254 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
4257 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4259 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
4260 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4264 do ilist=1,ishield_list(j)
4265 iresshield=shield_list(ilist,j)
4267 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
4270 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4272 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
4273 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4280 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
4281 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4282 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
4283 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4284 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
4285 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4286 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
4287 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4292 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4293 c & ' eel_loc_ij',eel_loc_ij
4294 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4295 C Calculate patrial derivative for theta angle
4297 geel_loc_ij=(a22*gmuij1(1)
4301 & *fac_shield(i)*fac_shield(j)
4302 c write(iout,*) "derivative over thatai"
4303 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4305 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4306 & geel_loc_ij*wel_loc
4307 c write(iout,*) "derivative over thatai-1"
4308 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4315 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4316 & geel_loc_ij*wel_loc
4317 & *fac_shield(i)*fac_shield(j)
4319 c Derivative over j residue
4320 geel_loc_ji=a22*gmuji1(1)
4324 c write(iout,*) "derivative over thataj"
4325 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4328 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4329 & geel_loc_ji*wel_loc
4330 & *fac_shield(i)*fac_shield(j)
4337 c write(iout,*) "derivative over thataj-1"
4338 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4340 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4341 & geel_loc_ji*wel_loc
4342 & *fac_shield(i)*fac_shield(j)
4344 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4346 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4347 & 'eelloc',i,j,eel_loc_ij
4348 c if (eel_loc_ij.ne.0)
4349 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4350 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4352 eel_loc=eel_loc+eel_loc_ij
4353 C Partial derivatives in virtual-bond dihedral angles gamma
4355 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4356 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4357 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
4358 & *fac_shield(i)*fac_shield(j)
4360 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4361 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4362 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
4363 & *fac_shield(i)*fac_shield(j)
4364 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4366 ggg(l)=(agg(l,1)*muij(1)+
4367 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
4368 & *fac_shield(i)*fac_shield(j)
4369 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4370 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4371 cgrad ghalf=0.5d0*ggg(l)
4372 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4373 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4377 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4380 C Remaining derivatives of eello
4382 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4383 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4384 & *fac_shield(i)*fac_shield(j)
4386 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4387 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4388 & *fac_shield(i)*fac_shield(j)
4390 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4391 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4392 & *fac_shield(i)*fac_shield(j)
4394 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4395 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4396 & *fac_shield(i)*fac_shield(j)
4400 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4401 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4402 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4403 & .and. num_conti.le.maxconts) then
4404 c write (iout,*) i,j," entered corr"
4406 C Calculate the contact function. The ith column of the array JCONT will
4407 C contain the numbers of atoms that make contacts with the atom I (of numbers
4408 C greater than I). The arrays FACONT and GACONT will contain the values of
4409 C the contact function and its derivative.
4410 c r0ij=1.02D0*rpp(iteli,itelj)
4411 c r0ij=1.11D0*rpp(iteli,itelj)
4412 r0ij=2.20D0*rpp(iteli,itelj)
4413 c r0ij=1.55D0*rpp(iteli,itelj)
4414 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4415 if (fcont.gt.0.0D0) then
4416 num_conti=num_conti+1
4417 if (num_conti.gt.maxconts) then
4418 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4419 & ' will skip next contacts for this conf.'
4421 jcont_hb(num_conti,i)=j
4422 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4423 cd & " jcont_hb",jcont_hb(num_conti,i)
4424 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4425 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4426 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4428 d_cont(num_conti,i)=rij
4429 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4430 C --- Electrostatic-interaction matrix ---
4431 a_chuj(1,1,num_conti,i)=a22
4432 a_chuj(1,2,num_conti,i)=a23
4433 a_chuj(2,1,num_conti,i)=a32
4434 a_chuj(2,2,num_conti,i)=a33
4435 C --- Gradient of rij
4437 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4444 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4445 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4446 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4447 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4448 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4453 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4454 C Calculate contact energies
4456 wij=cosa-3.0D0*cosb*cosg
4459 c fac3=dsqrt(-ael6i)/r0ij**3
4460 fac3=dsqrt(-ael6i)*r3ij
4461 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4462 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4463 if (ees0tmp.gt.0) then
4464 ees0pij=dsqrt(ees0tmp)
4468 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4469 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4470 if (ees0tmp.gt.0) then
4471 ees0mij=dsqrt(ees0tmp)
4476 if (shield_mode.eq.0) then
4480 ees0plist(num_conti,i)=j
4481 C fac_shield(i)=0.4d0
4482 C fac_shield(j)=0.6d0
4484 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4485 & *fac_shield(i)*fac_shield(j)
4486 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4487 & *fac_shield(i)*fac_shield(j)
4488 C Diagnostics. Comment out or remove after debugging!
4489 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4490 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4491 c ees0m(num_conti,i)=0.0D0
4493 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4494 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4495 C Angular derivatives of the contact function
4496 ees0pij1=fac3/ees0pij
4497 ees0mij1=fac3/ees0mij
4498 fac3p=-3.0D0*fac3*rrmij
4499 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4500 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4502 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4503 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4504 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4505 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4506 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4507 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4508 ecosap=ecosa1+ecosa2
4509 ecosbp=ecosb1+ecosb2
4510 ecosgp=ecosg1+ecosg2
4511 ecosam=ecosa1-ecosa2
4512 ecosbm=ecosb1-ecosb2
4513 ecosgm=ecosg1-ecosg2
4522 facont_hb(num_conti,i)=fcont
4523 fprimcont=fprimcont/rij
4524 cd facont_hb(num_conti,i)=1.0D0
4525 C Following line is for diagnostics.
4528 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4529 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4532 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4533 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4535 gggp(1)=gggp(1)+ees0pijp*xj
4536 gggp(2)=gggp(2)+ees0pijp*yj
4537 gggp(3)=gggp(3)+ees0pijp*zj
4538 gggm(1)=gggm(1)+ees0mijp*xj
4539 gggm(2)=gggm(2)+ees0mijp*yj
4540 gggm(3)=gggm(3)+ees0mijp*zj
4541 C Derivatives due to the contact function
4542 gacont_hbr(1,num_conti,i)=fprimcont*xj
4543 gacont_hbr(2,num_conti,i)=fprimcont*yj
4544 gacont_hbr(3,num_conti,i)=fprimcont*zj
4547 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4548 c following the change of gradient-summation algorithm.
4550 cgrad ghalfp=0.5D0*gggp(k)
4551 cgrad ghalfm=0.5D0*gggm(k)
4552 gacontp_hb1(k,num_conti,i)=!ghalfp
4553 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4554 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4555 & *fac_shield(i)*fac_shield(j)
4557 gacontp_hb2(k,num_conti,i)=!ghalfp
4558 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4559 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4560 & *fac_shield(i)*fac_shield(j)
4562 gacontp_hb3(k,num_conti,i)=gggp(k)
4563 & *fac_shield(i)*fac_shield(j)
4565 gacontm_hb1(k,num_conti,i)=!ghalfm
4566 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4567 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4568 & *fac_shield(i)*fac_shield(j)
4570 gacontm_hb2(k,num_conti,i)=!ghalfm
4571 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4572 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4573 & *fac_shield(i)*fac_shield(j)
4575 gacontm_hb3(k,num_conti,i)=gggm(k)
4576 & *fac_shield(i)*fac_shield(j)
4579 C Diagnostics. Comment out or remove after debugging!
4581 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4582 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4583 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4584 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4585 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4586 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4589 endif ! num_conti.le.maxconts
4592 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4595 ghalf=0.5d0*agg(l,k)
4596 aggi(l,k)=aggi(l,k)+ghalf
4597 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4598 aggj(l,k)=aggj(l,k)+ghalf
4601 if (j.eq.nres-1 .and. i.lt.j-2) then
4604 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4609 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4612 C-----------------------------------------------------------------------------
4613 subroutine eturn3(i,eello_turn3)
4614 C Third- and fourth-order contributions from turns
4615 implicit real*8 (a-h,o-z)
4616 include 'DIMENSIONS'
4617 include 'COMMON.IOUNITS'
4618 include 'COMMON.GEO'
4619 include 'COMMON.VAR'
4620 include 'COMMON.LOCAL'
4621 include 'COMMON.CHAIN'
4622 include 'COMMON.DERIV'
4623 include 'COMMON.INTERACT'
4624 include 'COMMON.CONTACTS'
4625 include 'COMMON.TORSION'
4626 include 'COMMON.VECTORS'
4627 include 'COMMON.FFIELD'
4628 include 'COMMON.CONTROL'
4629 include 'COMMON.SHIELD'
4631 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4632 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4633 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4634 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4635 & auxgmat2(2,2),auxgmatt2(2,2)
4636 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4637 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4638 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4639 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4642 c write (iout,*) "eturn3",i,j,j1,j2
4647 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4649 C Third-order contributions
4656 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4657 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4658 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4659 c auxalary matices for theta gradient
4660 c auxalary matrix for i+1 and constant i+2
4661 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4662 c auxalary matrix for i+2 and constant i+1
4663 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4664 call transpose2(auxmat(1,1),auxmat1(1,1))
4665 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4666 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4667 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4668 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4669 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4670 if (shield_mode.eq.0) then
4677 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4678 & *fac_shield(i)*fac_shield(j)
4679 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
4680 & *fac_shield(i)*fac_shield(j)
4681 C Derivatives in theta
4682 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4683 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4684 & *fac_shield(i)*fac_shield(j)
4685 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4686 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4687 & *fac_shield(i)*fac_shield(j)
4690 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4691 C Derivatives in shield mode
4692 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4693 & (shield_mode.gt.0)) then
4696 do ilist=1,ishield_list(i)
4697 iresshield=shield_list(ilist,i)
4699 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4701 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4703 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4704 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4708 do ilist=1,ishield_list(j)
4709 iresshield=shield_list(ilist,j)
4711 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4713 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4715 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4716 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4723 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
4724 & grad_shield(k,i)*eello_t3/fac_shield(i)
4725 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
4726 & grad_shield(k,j)*eello_t3/fac_shield(j)
4727 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
4728 & grad_shield(k,i)*eello_t3/fac_shield(i)
4729 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
4730 & grad_shield(k,j)*eello_t3/fac_shield(j)
4734 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4735 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4736 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4737 cd & ' eello_turn3_num',4*eello_turn3_num
4738 C Derivatives in gamma(i)
4739 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4740 call transpose2(auxmat2(1,1),auxmat3(1,1))
4741 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4742 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4743 & *fac_shield(i)*fac_shield(j)
4744 C Derivatives in gamma(i+1)
4745 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4746 call transpose2(auxmat2(1,1),auxmat3(1,1))
4747 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4748 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4749 & +0.5d0*(pizda(1,1)+pizda(2,2))
4750 & *fac_shield(i)*fac_shield(j)
4751 C Cartesian derivatives
4753 c ghalf1=0.5d0*agg(l,1)
4754 c ghalf2=0.5d0*agg(l,2)
4755 c ghalf3=0.5d0*agg(l,3)
4756 c ghalf4=0.5d0*agg(l,4)
4757 a_temp(1,1)=aggi(l,1)!+ghalf1
4758 a_temp(1,2)=aggi(l,2)!+ghalf2
4759 a_temp(2,1)=aggi(l,3)!+ghalf3
4760 a_temp(2,2)=aggi(l,4)!+ghalf4
4761 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4762 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4763 & +0.5d0*(pizda(1,1)+pizda(2,2))
4764 & *fac_shield(i)*fac_shield(j)
4766 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4767 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4768 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4769 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4770 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4771 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4772 & +0.5d0*(pizda(1,1)+pizda(2,2))
4773 & *fac_shield(i)*fac_shield(j)
4774 a_temp(1,1)=aggj(l,1)!+ghalf1
4775 a_temp(1,2)=aggj(l,2)!+ghalf2
4776 a_temp(2,1)=aggj(l,3)!+ghalf3
4777 a_temp(2,2)=aggj(l,4)!+ghalf4
4778 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4779 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4780 & +0.5d0*(pizda(1,1)+pizda(2,2))
4781 & *fac_shield(i)*fac_shield(j)
4782 a_temp(1,1)=aggj1(l,1)
4783 a_temp(1,2)=aggj1(l,2)
4784 a_temp(2,1)=aggj1(l,3)
4785 a_temp(2,2)=aggj1(l,4)
4786 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4787 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4788 & +0.5d0*(pizda(1,1)+pizda(2,2))
4789 & *fac_shield(i)*fac_shield(j)
4793 C-------------------------------------------------------------------------------
4794 subroutine eturn4(i,eello_turn4)
4795 C Third- and fourth-order contributions from turns
4796 implicit real*8 (a-h,o-z)
4797 include 'DIMENSIONS'
4798 include 'COMMON.IOUNITS'
4799 include 'COMMON.GEO'
4800 include 'COMMON.VAR'
4801 include 'COMMON.LOCAL'
4802 include 'COMMON.CHAIN'
4803 include 'COMMON.DERIV'
4804 include 'COMMON.INTERACT'
4805 include 'COMMON.CONTACTS'
4806 include 'COMMON.TORSION'
4807 include 'COMMON.VECTORS'
4808 include 'COMMON.FFIELD'
4809 include 'COMMON.CONTROL'
4810 include 'COMMON.SHIELD'
4812 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4813 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4814 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4815 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4816 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4817 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4818 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4819 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4820 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4821 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4822 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4825 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4827 C Fourth-order contributions
4835 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4836 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4837 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4838 c write(iout,*)"WCHODZE W PROGRAM"
4843 iti1=itype2loc(itype(i+1))
4844 iti2=itype2loc(itype(i+2))
4845 iti3=itype2loc(itype(i+3))
4846 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4847 call transpose2(EUg(1,1,i+1),e1t(1,1))
4848 call transpose2(Eug(1,1,i+2),e2t(1,1))
4849 call transpose2(Eug(1,1,i+3),e3t(1,1))
4850 C Ematrix derivative in theta
4851 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4852 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4853 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4854 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4855 c eta1 in derivative theta
4856 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4857 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4858 c auxgvec is derivative of Ub2 so i+3 theta
4859 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4860 c auxalary matrix of E i+1
4861 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4864 s1=scalar2(b1(1,i+2),auxvec(1))
4865 c derivative of theta i+2 with constant i+3
4866 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4867 c derivative of theta i+2 with constant i+2
4868 gs32=scalar2(b1(1,i+2),auxgvec(1))
4869 c derivative of E matix in theta of i+1
4870 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4872 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4873 c ea31 in derivative theta
4874 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4875 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4876 c auxilary matrix auxgvec of Ub2 with constant E matirx
4877 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4878 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4879 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4883 s2=scalar2(b1(1,i+1),auxvec(1))
4884 c derivative of theta i+1 with constant i+3
4885 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4886 c derivative of theta i+2 with constant i+1
4887 gs21=scalar2(b1(1,i+1),auxgvec(1))
4888 c derivative of theta i+3 with constant i+1
4889 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4890 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4892 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4893 c two derivatives over diffetent matrices
4894 c gtae3e2 is derivative over i+3
4895 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4896 c ae3gte2 is derivative over i+2
4897 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4898 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4899 c three possible derivative over theta E matices
4901 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4903 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4905 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4906 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4908 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4909 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4910 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4911 if (shield_mode.eq.0) then
4918 eello_turn4=eello_turn4-(s1+s2+s3)
4919 & *fac_shield(i)*fac_shield(j)
4920 eello_t4=-(s1+s2+s3)
4921 & *fac_shield(i)*fac_shield(j)
4922 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4923 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4924 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4925 C Now derivative over shield:
4926 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4927 & (shield_mode.gt.0)) then
4930 do ilist=1,ishield_list(i)
4931 iresshield=shield_list(ilist,i)
4933 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
4935 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
4937 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
4938 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
4942 do ilist=1,ishield_list(j)
4943 iresshield=shield_list(ilist,j)
4945 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
4947 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
4949 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
4950 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
4957 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
4958 & grad_shield(k,i)*eello_t4/fac_shield(i)
4959 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
4960 & grad_shield(k,j)*eello_t4/fac_shield(j)
4961 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
4962 & grad_shield(k,i)*eello_t4/fac_shield(i)
4963 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
4964 & grad_shield(k,j)*eello_t4/fac_shield(j)
4973 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4974 cd & ' eello_turn4_num',8*eello_turn4_num
4976 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4977 & -(gs13+gsE13+gsEE1)*wturn4
4978 & *fac_shield(i)*fac_shield(j)
4979 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4980 & -(gs23+gs21+gsEE2)*wturn4
4981 & *fac_shield(i)*fac_shield(j)
4983 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4984 & -(gs32+gsE31+gsEE3)*wturn4
4985 & *fac_shield(i)*fac_shield(j)
4987 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4990 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4991 & 'eturn4',i,j,-(s1+s2+s3)
4992 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4993 c & ' eello_turn4_num',8*eello_turn4_num
4994 C Derivatives in gamma(i)
4995 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4996 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4997 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4998 s1=scalar2(b1(1,i+2),auxvec(1))
4999 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
5000 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5001 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
5002 & *fac_shield(i)*fac_shield(j)
5003 C Derivatives in gamma(i+1)
5004 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
5005 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
5006 s2=scalar2(b1(1,i+1),auxvec(1))
5007 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5008 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5009 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5010 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
5011 & *fac_shield(i)*fac_shield(j)
5012 C Derivatives in gamma(i+2)
5013 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5014 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5015 s1=scalar2(b1(1,i+2),auxvec(1))
5016 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5017 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5018 s2=scalar2(b1(1,i+1),auxvec(1))
5019 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5020 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5021 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5022 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
5023 & *fac_shield(i)*fac_shield(j)
5024 C Cartesian derivatives
5025 C Derivatives of this turn contributions in DC(i+2)
5026 if (j.lt.nres-1) then
5028 a_temp(1,1)=agg(l,1)
5029 a_temp(1,2)=agg(l,2)
5030 a_temp(2,1)=agg(l,3)
5031 a_temp(2,2)=agg(l,4)
5032 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5033 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5034 s1=scalar2(b1(1,i+2),auxvec(1))
5035 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5036 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5037 s2=scalar2(b1(1,i+1),auxvec(1))
5038 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5039 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5040 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5042 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
5043 & *fac_shield(i)*fac_shield(j)
5046 C Remaining derivatives of this turn contribution
5048 a_temp(1,1)=aggi(l,1)
5049 a_temp(1,2)=aggi(l,2)
5050 a_temp(2,1)=aggi(l,3)
5051 a_temp(2,2)=aggi(l,4)
5052 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5053 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5054 s1=scalar2(b1(1,i+2),auxvec(1))
5055 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5056 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5057 s2=scalar2(b1(1,i+1),auxvec(1))
5058 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5059 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5060 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5061 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
5062 & *fac_shield(i)*fac_shield(j)
5063 a_temp(1,1)=aggi1(l,1)
5064 a_temp(1,2)=aggi1(l,2)
5065 a_temp(2,1)=aggi1(l,3)
5066 a_temp(2,2)=aggi1(l,4)
5067 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5068 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5069 s1=scalar2(b1(1,i+2),auxvec(1))
5070 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5071 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5072 s2=scalar2(b1(1,i+1),auxvec(1))
5073 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5074 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5075 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5076 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
5077 & *fac_shield(i)*fac_shield(j)
5078 a_temp(1,1)=aggj(l,1)
5079 a_temp(1,2)=aggj(l,2)
5080 a_temp(2,1)=aggj(l,3)
5081 a_temp(2,2)=aggj(l,4)
5082 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5083 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5084 s1=scalar2(b1(1,i+2),auxvec(1))
5085 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5086 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5087 s2=scalar2(b1(1,i+1),auxvec(1))
5088 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5089 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5090 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5091 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
5092 & *fac_shield(i)*fac_shield(j)
5093 a_temp(1,1)=aggj1(l,1)
5094 a_temp(1,2)=aggj1(l,2)
5095 a_temp(2,1)=aggj1(l,3)
5096 a_temp(2,2)=aggj1(l,4)
5097 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5098 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5099 s1=scalar2(b1(1,i+2),auxvec(1))
5100 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5101 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5102 s2=scalar2(b1(1,i+1),auxvec(1))
5103 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5104 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5105 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5106 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5107 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
5108 & *fac_shield(i)*fac_shield(j)
5112 C-----------------------------------------------------------------------------
5113 subroutine vecpr(u,v,w)
5114 implicit real*8(a-h,o-z)
5115 dimension u(3),v(3),w(3)
5116 w(1)=u(2)*v(3)-u(3)*v(2)
5117 w(2)=-u(1)*v(3)+u(3)*v(1)
5118 w(3)=u(1)*v(2)-u(2)*v(1)
5121 C-----------------------------------------------------------------------------
5122 subroutine unormderiv(u,ugrad,unorm,ungrad)
5123 C This subroutine computes the derivatives of a normalized vector u, given
5124 C the derivatives computed without normalization conditions, ugrad. Returns
5127 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
5128 double precision vec(3)
5129 double precision scalar
5131 c write (2,*) 'ugrad',ugrad
5134 vec(i)=scalar(ugrad(1,i),u(1))
5136 c write (2,*) 'vec',vec
5139 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5142 c write (2,*) 'ungrad',ungrad
5145 C-----------------------------------------------------------------------------
5146 subroutine escp_soft_sphere(evdw2,evdw2_14)
5148 C This subroutine calculates the excluded-volume interaction energy between
5149 C peptide-group centers and side chains and its gradient in virtual-bond and
5150 C side-chain vectors.
5152 implicit real*8 (a-h,o-z)
5153 include 'DIMENSIONS'
5154 include 'COMMON.GEO'
5155 include 'COMMON.VAR'
5156 include 'COMMON.LOCAL'
5157 include 'COMMON.CHAIN'
5158 include 'COMMON.DERIV'
5159 include 'COMMON.INTERACT'
5160 include 'COMMON.FFIELD'
5161 include 'COMMON.IOUNITS'
5162 include 'COMMON.CONTROL'
5167 cd print '(a)','Enter ESCP'
5168 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5172 do i=iatscp_s,iatscp_e
5173 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5175 xi=0.5D0*(c(1,i)+c(1,i+1))
5176 yi=0.5D0*(c(2,i)+c(2,i+1))
5177 zi=0.5D0*(c(3,i)+c(3,i+1))
5178 C Return atom into box, boxxsize is size of box in x dimension
5180 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5181 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5182 C Condition for being inside the proper box
5183 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5184 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5188 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5189 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5190 C Condition for being inside the proper box
5191 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5192 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5196 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5197 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5198 cC Condition for being inside the proper box
5199 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5200 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5204 if (xi.lt.0) xi=xi+boxxsize
5206 if (yi.lt.0) yi=yi+boxysize
5208 if (zi.lt.0) zi=zi+boxzsize
5209 C xi=xi+xshift*boxxsize
5210 C yi=yi+yshift*boxysize
5211 C zi=zi+zshift*boxzsize
5212 do iint=1,nscp_gr(i)
5214 do j=iscpstart(i,iint),iscpend(i,iint)
5215 if (itype(j).eq.ntyp1) cycle
5216 itypj=iabs(itype(j))
5217 C Uncomment following three lines for SC-p interactions
5221 C Uncomment following three lines for Ca-p interactions
5226 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5227 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5228 C Condition for being inside the proper box
5229 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5230 c & (xj.lt.((-0.5d0)*boxxsize))) then
5234 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5235 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5236 cC Condition for being inside the proper box
5237 c if ((yj.gt.((0.5d0)*boxysize)).or.
5238 c & (yj.lt.((-0.5d0)*boxysize))) then
5242 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5243 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5244 C Condition for being inside the proper box
5245 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5246 c & (zj.lt.((-0.5d0)*boxzsize))) then
5249 if (xj.lt.0) xj=xj+boxxsize
5251 if (yj.lt.0) yj=yj+boxysize
5253 if (zj.lt.0) zj=zj+boxzsize
5254 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5262 xj=xj_safe+xshift*boxxsize
5263 yj=yj_safe+yshift*boxysize
5264 zj=zj_safe+zshift*boxzsize
5265 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5266 if(dist_temp.lt.dist_init) then
5276 if (subchap.eq.1) then
5289 rij=xj*xj+yj*yj+zj*zj
5293 if (rij.lt.r0ijsq) then
5294 evdwij=0.25d0*(rij-r0ijsq)**2
5302 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5307 cgrad if (j.lt.i) then
5308 cd write (iout,*) 'j<i'
5309 C Uncomment following three lines for SC-p interactions
5311 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5314 cd write (iout,*) 'j>i'
5316 cgrad ggg(k)=-ggg(k)
5317 C Uncomment following line for SC-p interactions
5318 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5322 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5324 cgrad kstart=min0(i+1,j)
5325 cgrad kend=max0(i-1,j-1)
5326 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5327 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5328 cgrad do k=kstart,kend
5330 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5334 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5335 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5346 C-----------------------------------------------------------------------------
5347 subroutine escp(evdw2,evdw2_14)
5349 C This subroutine calculates the excluded-volume interaction energy between
5350 C peptide-group centers and side chains and its gradient in virtual-bond and
5351 C side-chain vectors.
5353 implicit real*8 (a-h,o-z)
5354 include 'DIMENSIONS'
5355 include 'COMMON.GEO'
5356 include 'COMMON.VAR'
5357 include 'COMMON.LOCAL'
5358 include 'COMMON.CHAIN'
5359 include 'COMMON.DERIV'
5360 include 'COMMON.INTERACT'
5361 include 'COMMON.FFIELD'
5362 include 'COMMON.IOUNITS'
5363 include 'COMMON.CONTROL'
5364 include 'COMMON.SPLITELE'
5368 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
5369 cd print '(a)','Enter ESCP'
5370 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5374 do i=iatscp_s,iatscp_e
5375 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5377 xi=0.5D0*(c(1,i)+c(1,i+1))
5378 yi=0.5D0*(c(2,i)+c(2,i+1))
5379 zi=0.5D0*(c(3,i)+c(3,i+1))
5381 if (xi.lt.0) xi=xi+boxxsize
5383 if (yi.lt.0) yi=yi+boxysize
5385 if (zi.lt.0) zi=zi+boxzsize
5386 c xi=xi+xshift*boxxsize
5387 c yi=yi+yshift*boxysize
5388 c zi=zi+zshift*boxzsize
5389 c print *,xi,yi,zi,'polozenie i'
5390 C Return atom into box, boxxsize is size of box in x dimension
5392 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5393 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5394 C Condition for being inside the proper box
5395 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5396 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5400 c print *,xi,boxxsize,"pierwszy"
5402 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5403 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5404 C Condition for being inside the proper box
5405 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5406 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5410 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5411 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5412 C Condition for being inside the proper box
5413 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5414 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5417 do iint=1,nscp_gr(i)
5419 do j=iscpstart(i,iint),iscpend(i,iint)
5420 itypj=iabs(itype(j))
5421 if (itypj.eq.ntyp1) cycle
5422 C Uncomment following three lines for SC-p interactions
5426 C Uncomment following three lines for Ca-p interactions
5431 if (xj.lt.0) xj=xj+boxxsize
5433 if (yj.lt.0) yj=yj+boxysize
5435 if (zj.lt.0) zj=zj+boxzsize
5437 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5438 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5439 C Condition for being inside the proper box
5440 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5441 c & (xj.lt.((-0.5d0)*boxxsize))) then
5445 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5446 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5447 cC Condition for being inside the proper box
5448 c if ((yj.gt.((0.5d0)*boxysize)).or.
5449 c & (yj.lt.((-0.5d0)*boxysize))) then
5453 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5454 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5455 C Condition for being inside the proper box
5456 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5457 c & (zj.lt.((-0.5d0)*boxzsize))) then
5460 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5461 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5469 xj=xj_safe+xshift*boxxsize
5470 yj=yj_safe+yshift*boxysize
5471 zj=zj_safe+zshift*boxzsize
5472 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5473 if(dist_temp.lt.dist_init) then
5483 if (subchap.eq.1) then
5492 c print *,xj,yj,zj,'polozenie j'
5493 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5495 sss=sscale(1.0d0/(dsqrt(rrij)))
5496 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5497 c if (sss.eq.0) print *,'czasem jest OK'
5498 if (sss.le.0.0d0) cycle
5499 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5501 e1=fac*fac*aad(itypj,iteli)
5502 e2=fac*bad(itypj,iteli)
5503 if (iabs(j-i) .le. 2) then
5506 evdw2_14=evdw2_14+(e1+e2)*sss
5509 evdw2=evdw2+evdwij*sss
5510 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5511 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5514 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5516 fac=-(evdwij+e1)*rrij*sss
5517 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5521 cgrad if (j.lt.i) then
5522 cd write (iout,*) 'j<i'
5523 C Uncomment following three lines for SC-p interactions
5525 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5528 cd write (iout,*) 'j>i'
5530 cgrad ggg(k)=-ggg(k)
5531 C Uncomment following line for SC-p interactions
5532 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5533 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5537 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5539 cgrad kstart=min0(i+1,j)
5540 cgrad kend=max0(i-1,j-1)
5541 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5542 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5543 cgrad do k=kstart,kend
5545 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5549 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5550 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5552 c endif !endif for sscale cutoff
5562 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5563 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5564 gradx_scp(j,i)=expon*gradx_scp(j,i)
5567 C******************************************************************************
5571 C To save time the factor EXPON has been extracted from ALL components
5572 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5575 C******************************************************************************
5578 C--------------------------------------------------------------------------
5579 subroutine edis(ehpb)
5581 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5583 implicit real*8 (a-h,o-z)
5584 include 'DIMENSIONS'
5585 include 'COMMON.SBRIDGE'
5586 include 'COMMON.CHAIN'
5587 include 'COMMON.DERIV'
5588 include 'COMMON.VAR'
5589 include 'COMMON.INTERACT'
5590 include 'COMMON.IOUNITS'
5591 include 'COMMON.CONTROL'
5597 C write (iout,*) ,"link_end",link_end,constr_dist
5598 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5599 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5600 if (link_end.eq.0) return
5601 do i=link_start,link_end
5602 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5603 C CA-CA distance used in regularization of structure.
5606 C iii and jjj point to the residues for which the distance is assigned.
5607 if (ii.gt.nres) then
5614 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5615 c & dhpb(i),dhpb1(i),forcon(i)
5616 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5617 C distance and angle dependent SS bond potential.
5618 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5619 C & iabs(itype(jjj)).eq.1) then
5620 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5621 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5622 if (.not.dyn_ss .and. i.le.nss) then
5623 C 15/02/13 CC dynamic SSbond - additional check
5624 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5625 & iabs(itype(jjj)).eq.1) then
5626 call ssbond_ene(iii,jjj,eij)
5629 cd write (iout,*) "eij",eij
5630 cd & ' waga=',waga,' fac=',fac
5631 else if (ii.gt.nres .and. jj.gt.nres) then
5632 c Restraints from contact prediction
5634 if (constr_dist.eq.11) then
5635 ehpb=ehpb+fordepth(i)**4.0d0
5636 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5637 fac=fordepth(i)**4.0d0
5638 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5639 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5640 & ehpb,fordepth(i),dd
5642 if (dhpb1(i).gt.0.0d0) then
5643 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5644 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5645 c write (iout,*) "beta nmr",
5646 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5650 C Get the force constant corresponding to this distance.
5652 C Calculate the contribution to energy.
5653 ehpb=ehpb+waga*rdis*rdis
5654 c write (iout,*) "beta reg",dd,waga*rdis*rdis
5656 C Evaluate gradient.
5662 ggg(j)=fac*(c(j,jj)-c(j,ii))
5665 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5666 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5669 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5670 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5673 C Calculate the distance between the two points and its difference from the
5676 if (constr_dist.eq.11) then
5677 ehpb=ehpb+fordepth(i)**4.0d0
5678 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5679 fac=fordepth(i)**4.0d0
5680 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5681 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5682 & ehpb,fordepth(i),dd
5684 if (dhpb1(i).gt.0.0d0) then
5685 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5686 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5687 c write (iout,*) "alph nmr",
5688 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5691 C Get the force constant corresponding to this distance.
5693 C Calculate the contribution to energy.
5694 ehpb=ehpb+waga*rdis*rdis
5695 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5697 C Evaluate gradient.
5703 ggg(j)=fac*(c(j,jj)-c(j,ii))
5705 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5706 C If this is a SC-SC distance, we need to calculate the contributions to the
5707 C Cartesian gradient in the SC vectors (ghpbx).
5710 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5711 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5714 cgrad do j=iii,jjj-1
5716 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5720 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5721 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5725 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5728 C--------------------------------------------------------------------------
5729 subroutine ssbond_ene(i,j,eij)
5731 C Calculate the distance and angle dependent SS-bond potential energy
5732 C using a free-energy function derived based on RHF/6-31G** ab initio
5733 C calculations of diethyl disulfide.
5735 C A. Liwo and U. Kozlowska, 11/24/03
5737 implicit real*8 (a-h,o-z)
5738 include 'DIMENSIONS'
5739 include 'COMMON.SBRIDGE'
5740 include 'COMMON.CHAIN'
5741 include 'COMMON.DERIV'
5742 include 'COMMON.LOCAL'
5743 include 'COMMON.INTERACT'
5744 include 'COMMON.VAR'
5745 include 'COMMON.IOUNITS'
5746 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5747 itypi=iabs(itype(i))
5751 dxi=dc_norm(1,nres+i)
5752 dyi=dc_norm(2,nres+i)
5753 dzi=dc_norm(3,nres+i)
5754 c dsci_inv=dsc_inv(itypi)
5755 dsci_inv=vbld_inv(nres+i)
5756 itypj=iabs(itype(j))
5757 c dscj_inv=dsc_inv(itypj)
5758 dscj_inv=vbld_inv(nres+j)
5762 dxj=dc_norm(1,nres+j)
5763 dyj=dc_norm(2,nres+j)
5764 dzj=dc_norm(3,nres+j)
5765 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5770 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5771 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5772 om12=dxi*dxj+dyi*dyj+dzi*dzj
5774 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5775 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5781 deltat12=om2-om1+2.0d0
5783 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5784 & +akct*deltad*deltat12
5785 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5786 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5787 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5788 c & " deltat12",deltat12," eij",eij
5789 ed=2*akcm*deltad+akct*deltat12
5791 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5792 eom1=-2*akth*deltat1-pom1-om2*pom2
5793 eom2= 2*akth*deltat2+pom1-om1*pom2
5796 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5797 ghpbx(k,i)=ghpbx(k,i)-ggk
5798 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5799 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5800 ghpbx(k,j)=ghpbx(k,j)+ggk
5801 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5802 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5803 ghpbc(k,i)=ghpbc(k,i)-ggk
5804 ghpbc(k,j)=ghpbc(k,j)+ggk
5807 C Calculate the components of the gradient in DC and X
5811 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5816 C--------------------------------------------------------------------------
5817 subroutine ebond(estr)
5819 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5821 implicit real*8 (a-h,o-z)
5822 include 'DIMENSIONS'
5823 include 'COMMON.LOCAL'
5824 include 'COMMON.GEO'
5825 include 'COMMON.INTERACT'
5826 include 'COMMON.DERIV'
5827 include 'COMMON.VAR'
5828 include 'COMMON.CHAIN'
5829 include 'COMMON.IOUNITS'
5830 include 'COMMON.NAMES'
5831 include 'COMMON.FFIELD'
5832 include 'COMMON.CONTROL'
5833 include 'COMMON.SETUP'
5834 double precision u(3),ud(3)
5837 do i=ibondp_start,ibondp_end
5838 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5839 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5841 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5842 c & *dc(j,i-1)/vbld(i)
5844 c if (energy_dec) write(iout,*)
5845 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5847 C Checking if it involves dummy (NH3+ or COO-) group
5848 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5849 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5850 diff = vbld(i)-vbldpDUM
5852 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5853 diff = vbld(i)-vbldp0
5855 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5856 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5859 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5861 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5864 estr=0.5d0*AKP*estr+estr1
5866 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5868 do i=ibond_start,ibond_end
5870 if (iti.ne.10 .and. iti.ne.ntyp1) then
5873 diff=vbld(i+nres)-vbldsc0(1,iti)
5874 if (energy_dec) write (iout,*)
5875 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5876 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5877 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5879 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5883 diff=vbld(i+nres)-vbldsc0(j,iti)
5884 ud(j)=aksc(j,iti)*diff
5885 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5899 uprod2=uprod2*u(k)*u(k)
5903 usumsqder=usumsqder+ud(j)*uprod2
5905 estr=estr+uprod/usum
5907 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5915 C--------------------------------------------------------------------------
5916 subroutine ebend(etheta,ethetacnstr)
5918 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5919 C angles gamma and its derivatives in consecutive thetas and gammas.
5921 implicit real*8 (a-h,o-z)
5922 include 'DIMENSIONS'
5923 include 'COMMON.LOCAL'
5924 include 'COMMON.GEO'
5925 include 'COMMON.INTERACT'
5926 include 'COMMON.DERIV'
5927 include 'COMMON.VAR'
5928 include 'COMMON.CHAIN'
5929 include 'COMMON.IOUNITS'
5930 include 'COMMON.NAMES'
5931 include 'COMMON.FFIELD'
5932 include 'COMMON.CONTROL'
5933 include 'COMMON.TORCNSTR'
5934 common /calcthet/ term1,term2,termm,diffak,ratak,
5935 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5936 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5937 double precision y(2),z(2)
5939 c time11=dexp(-2*time)
5942 c write (*,'(a,i2)') 'EBEND ICG=',icg
5943 do i=ithet_start,ithet_end
5944 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5945 & .or.itype(i).eq.ntyp1) cycle
5946 C Zero the energy function and its derivative at 0 or pi.
5947 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5949 ichir1=isign(1,itype(i-2))
5950 ichir2=isign(1,itype(i))
5951 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5952 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5953 if (itype(i-1).eq.10) then
5954 itype1=isign(10,itype(i-2))
5955 ichir11=isign(1,itype(i-2))
5956 ichir12=isign(1,itype(i-2))
5957 itype2=isign(10,itype(i))
5958 ichir21=isign(1,itype(i))
5959 ichir22=isign(1,itype(i))
5962 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5965 if (phii.ne.phii) phii=150.0
5975 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5978 if (phii1.ne.phii1) phii1=150.0
5990 C Calculate the "mean" value of theta from the part of the distribution
5991 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5992 C In following comments this theta will be referred to as t_c.
5993 thet_pred_mean=0.0d0
5995 athetk=athet(k,it,ichir1,ichir2)
5996 bthetk=bthet(k,it,ichir1,ichir2)
5998 athetk=athet(k,itype1,ichir11,ichir12)
5999 bthetk=bthet(k,itype2,ichir21,ichir22)
6001 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
6002 c write(iout,*) 'chuj tu', y(k),z(k)
6004 dthett=thet_pred_mean*ssd
6005 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
6006 C Derivatives of the "mean" values in gamma1 and gamma2.
6007 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
6008 &+athet(2,it,ichir1,ichir2)*y(1))*ss
6009 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
6010 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
6012 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
6013 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
6014 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
6015 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
6017 if (theta(i).gt.pi-delta) then
6018 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
6020 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
6021 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6022 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
6024 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
6026 else if (theta(i).lt.delta) then
6027 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
6028 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6029 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
6031 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
6032 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
6035 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
6038 etheta=etheta+ethetai
6039 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
6040 & 'ebend',i,ethetai,theta(i),itype(i)
6041 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
6042 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
6043 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
6046 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6047 do i=ithetaconstr_start,ithetaconstr_end
6048 itheta=itheta_constr(i)
6049 thetiii=theta(itheta)
6050 difi=pinorm(thetiii-theta_constr0(i))
6051 if (difi.gt.theta_drange(i)) then
6052 difi=difi-theta_drange(i)
6053 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6054 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6055 & +for_thet_constr(i)*difi**3
6056 else if (difi.lt.-drange(i)) then
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
6064 if (energy_dec) then
6065 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6066 & i,itheta,rad2deg*thetiii,
6067 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6068 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6069 & gloc(itheta+nphi-2,icg)
6073 C Ufff.... We've done all this!!!
6076 C---------------------------------------------------------------------------
6077 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
6079 implicit real*8 (a-h,o-z)
6080 include 'DIMENSIONS'
6081 include 'COMMON.LOCAL'
6082 include 'COMMON.IOUNITS'
6083 common /calcthet/ term1,term2,termm,diffak,ratak,
6084 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6085 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6086 C Calculate the contributions to both Gaussian lobes.
6087 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6088 C The "polynomial part" of the "standard deviation" of this part of
6089 C the distributioni.
6090 ccc write (iout,*) thetai,thet_pred_mean
6093 sig=sig*thet_pred_mean+polthet(j,it)
6095 C Derivative of the "interior part" of the "standard deviation of the"
6096 C gamma-dependent Gaussian lobe in t_c.
6097 sigtc=3*polthet(3,it)
6099 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6102 C Set the parameters of both Gaussian lobes of the distribution.
6103 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6104 fac=sig*sig+sigc0(it)
6107 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6108 sigsqtc=-4.0D0*sigcsq*sigtc
6109 c print *,i,sig,sigtc,sigsqtc
6110 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
6111 sigtc=-sigtc/(fac*fac)
6112 C Following variable is sigma(t_c)**(-2)
6113 sigcsq=sigcsq*sigcsq
6115 sig0inv=1.0D0/sig0i**2
6116 delthec=thetai-thet_pred_mean
6117 delthe0=thetai-theta0i
6118 term1=-0.5D0*sigcsq*delthec*delthec
6119 term2=-0.5D0*sig0inv*delthe0*delthe0
6120 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
6121 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6122 C NaNs in taking the logarithm. We extract the largest exponent which is added
6123 C to the energy (this being the log of the distribution) at the end of energy
6124 C term evaluation for this virtual-bond angle.
6125 if (term1.gt.term2) then
6127 term2=dexp(term2-termm)
6131 term1=dexp(term1-termm)
6134 C The ratio between the gamma-independent and gamma-dependent lobes of
6135 C the distribution is a Gaussian function of thet_pred_mean too.
6136 diffak=gthet(2,it)-thet_pred_mean
6137 ratak=diffak/gthet(3,it)**2
6138 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6139 C Let's differentiate it in thet_pred_mean NOW.
6141 C Now put together the distribution terms to make complete distribution.
6142 termexp=term1+ak*term2
6143 termpre=sigc+ak*sig0i
6144 C Contribution of the bending energy from this theta is just the -log of
6145 C the sum of the contributions from the two lobes and the pre-exponential
6146 C factor. Simple enough, isn't it?
6147 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6148 C write (iout,*) 'termexp',termexp,termm,termpre,i
6149 C NOW the derivatives!!!
6150 C 6/6/97 Take into account the deformation.
6151 E_theta=(delthec*sigcsq*term1
6152 & +ak*delthe0*sig0inv*term2)/termexp
6153 E_tc=((sigtc+aktc*sig0i)/termpre
6154 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
6155 & aktc*term2)/termexp)
6158 c-----------------------------------------------------------------------------
6159 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
6160 implicit real*8 (a-h,o-z)
6161 include 'DIMENSIONS'
6162 include 'COMMON.LOCAL'
6163 include 'COMMON.IOUNITS'
6164 common /calcthet/ term1,term2,termm,diffak,ratak,
6165 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6166 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6167 delthec=thetai-thet_pred_mean
6168 delthe0=thetai-theta0i
6169 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
6170 t3 = thetai-thet_pred_mean
6174 t14 = t12+t6*sigsqtc
6176 t21 = thetai-theta0i
6182 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
6183 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
6184 & *(-t12*t9-ak*sig0inv*t27)
6188 C--------------------------------------------------------------------------
6189 subroutine ebend(etheta,ethetacnstr)
6191 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6192 C angles gamma and its derivatives in consecutive thetas and gammas.
6193 C ab initio-derived potentials from
6194 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6196 implicit real*8 (a-h,o-z)
6197 include 'DIMENSIONS'
6198 include 'COMMON.LOCAL'
6199 include 'COMMON.GEO'
6200 include 'COMMON.INTERACT'
6201 include 'COMMON.DERIV'
6202 include 'COMMON.VAR'
6203 include 'COMMON.CHAIN'
6204 include 'COMMON.IOUNITS'
6205 include 'COMMON.NAMES'
6206 include 'COMMON.FFIELD'
6207 include 'COMMON.CONTROL'
6208 include 'COMMON.TORCNSTR'
6209 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
6210 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
6211 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
6212 & sinph1ph2(maxdouble,maxdouble)
6213 logical lprn /.false./, lprn1 /.false./
6215 do i=ithet_start,ithet_end
6216 c print *,i,itype(i-1),itype(i),itype(i-2)
6217 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6218 & .or.itype(i).eq.ntyp1) cycle
6219 C print *,i,theta(i)
6220 if (iabs(itype(i+1)).eq.20) iblock=2
6221 if (iabs(itype(i+1)).ne.20) iblock=1
6225 theti2=0.5d0*theta(i)
6226 ityp2=ithetyp((itype(i-1)))
6228 coskt(k)=dcos(k*theti2)
6229 sinkt(k)=dsin(k*theti2)
6232 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
6235 if (phii.ne.phii) phii=150.0
6239 ityp1=ithetyp((itype(i-2)))
6240 C propagation of chirality for glycine type
6242 cosph1(k)=dcos(k*phii)
6243 sinph1(k)=dsin(k*phii)
6248 ityp1=ithetyp((itype(i-2)))
6253 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6256 if (phii1.ne.phii1) phii1=150.0
6261 ityp3=ithetyp((itype(i)))
6263 cosph2(k)=dcos(k*phii1)
6264 sinph2(k)=dsin(k*phii1)
6268 ityp3=ithetyp((itype(i)))
6274 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
6277 ccl=cosph1(l)*cosph2(k-l)
6278 ssl=sinph1(l)*sinph2(k-l)
6279 scl=sinph1(l)*cosph2(k-l)
6280 csl=cosph1(l)*sinph2(k-l)
6281 cosph1ph2(l,k)=ccl-ssl
6282 cosph1ph2(k,l)=ccl+ssl
6283 sinph1ph2(l,k)=scl+csl
6284 sinph1ph2(k,l)=scl-csl
6288 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
6289 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6290 write (iout,*) "coskt and sinkt"
6292 write (iout,*) k,coskt(k),sinkt(k)
6296 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6297 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
6300 & write (iout,*) "k",k,"
6301 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
6302 & " ethetai",ethetai
6305 write (iout,*) "cosph and sinph"
6307 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6309 write (iout,*) "cosph1ph2 and sinph2ph2"
6312 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6313 & sinph1ph2(l,k),sinph1ph2(k,l)
6316 write(iout,*) "ethetai",ethetai
6321 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
6322 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
6323 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
6324 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6325 ethetai=ethetai+sinkt(m)*aux
6326 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6327 dephii=dephii+k*sinkt(m)*(
6328 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
6329 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6330 dephii1=dephii1+k*sinkt(m)*(
6331 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
6332 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6334 & write (iout,*) "m",m," k",k," bbthet",
6335 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
6336 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
6337 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
6338 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6339 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6342 C print *,"cosph1", (cosph1(k), k=1,nsingle)
6343 C print *,"cosph2", (cosph2(k), k=1,nsingle)
6344 C print *,"sinph1", (sinph1(k), k=1,nsingle)
6345 C print *,"sinph2", (sinph2(k), k=1,nsingle)
6347 & write(iout,*) "ethetai",ethetai
6348 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6352 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6353 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
6354 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6355 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6356 ethetai=ethetai+sinkt(m)*aux
6357 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6358 dephii=dephii+l*sinkt(m)*(
6359 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
6360 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6361 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6362 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6363 dephii1=dephii1+(k-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))
6369 write (iout,*) "m",m," k",k," l",l," ffthet",
6370 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6371 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
6372 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6373 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
6374 & " ethetai",ethetai
6375 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6376 & cosph1ph2(k,l)*sinkt(m),
6377 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6386 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6387 & i,theta(i)*rad2deg,phii*rad2deg,
6388 & phii1*rad2deg,ethetai
6390 etheta=etheta+ethetai
6391 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6392 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6393 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
6397 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6398 do i=ithetaconstr_start,ithetaconstr_end
6399 itheta=itheta_constr(i)
6400 thetiii=theta(itheta)
6401 difi=pinorm(thetiii-theta_constr0(i))
6402 if (difi.gt.theta_drange(i)) then
6403 difi=difi-theta_drange(i)
6404 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6405 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6406 & +for_thet_constr(i)*difi**3
6407 else if (difi.lt.-drange(i)) then
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
6415 if (energy_dec) then
6416 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6417 & i,itheta,rad2deg*thetiii,
6418 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6419 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6420 & gloc(itheta+nphi-2,icg)
6428 c-----------------------------------------------------------------------------
6429 subroutine esc(escloc)
6430 C Calculate the local energy of a side chain and its derivatives in the
6431 C corresponding virtual-bond valence angles THETA and the spherical angles
6433 implicit real*8 (a-h,o-z)
6434 include 'DIMENSIONS'
6435 include 'COMMON.GEO'
6436 include 'COMMON.LOCAL'
6437 include 'COMMON.VAR'
6438 include 'COMMON.INTERACT'
6439 include 'COMMON.DERIV'
6440 include 'COMMON.CHAIN'
6441 include 'COMMON.IOUNITS'
6442 include 'COMMON.NAMES'
6443 include 'COMMON.FFIELD'
6444 include 'COMMON.CONTROL'
6445 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6446 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6447 common /sccalc/ time11,time12,time112,theti,it,nlobit
6450 c write (iout,'(a)') 'ESC'
6451 do i=loc_start,loc_end
6453 if (it.eq.ntyp1) cycle
6454 if (it.eq.10) goto 1
6455 nlobit=nlob(iabs(it))
6456 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6457 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6458 theti=theta(i+1)-pipol
6463 if (x(2).gt.pi-delta) then
6467 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6469 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6470 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6472 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6473 & ddersc0(1),dersc(1))
6474 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6475 & ddersc0(3),dersc(3))
6477 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6479 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6480 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6481 & dersc0(2),esclocbi,dersc02)
6482 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6484 call splinthet(x(2),0.5d0*delta,ss,ssd)
6489 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6491 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6492 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6494 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6496 c write (iout,*) escloci
6497 else if (x(2).lt.delta) then
6501 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6503 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6504 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6506 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6507 & ddersc0(1),dersc(1))
6508 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6509 & ddersc0(3),dersc(3))
6511 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6513 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6514 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6515 & dersc0(2),esclocbi,dersc02)
6516 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6521 call splinthet(x(2),0.5d0*delta,ss,ssd)
6523 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6525 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6526 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6528 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6529 c write (iout,*) escloci
6531 call enesc(x,escloci,dersc,ddummy,.false.)
6534 escloc=escloc+escloci
6535 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6536 & 'escloc',i,escloci
6537 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6539 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6541 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6542 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6547 C---------------------------------------------------------------------------
6548 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6549 implicit real*8 (a-h,o-z)
6550 include 'DIMENSIONS'
6551 include 'COMMON.GEO'
6552 include 'COMMON.LOCAL'
6553 include 'COMMON.IOUNITS'
6554 common /sccalc/ time11,time12,time112,theti,it,nlobit
6555 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6556 double precision contr(maxlob,-1:1)
6558 c write (iout,*) 'it=',it,' nlobit=',nlobit
6562 if (mixed) ddersc(j)=0.0d0
6566 C Because of periodicity of the dependence of the SC energy in omega we have
6567 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6568 C To avoid underflows, first compute & store the exponents.
6576 z(k)=x(k)-censc(k,j,it)
6581 Axk=Axk+gaussc(l,k,j,it)*z(l)
6587 expfac=expfac+Ax(k,j,iii)*z(k)
6595 C As in the case of ebend, we want to avoid underflows in exponentiation and
6596 C subsequent NaNs and INFs in energy calculation.
6597 C Find the largest exponent
6601 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6605 cd print *,'it=',it,' emin=',emin
6607 C Compute the contribution to SC energy and derivatives
6612 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6613 if(adexp.ne.adexp) adexp=1.0
6616 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6618 cd print *,'j=',j,' expfac=',expfac
6619 escloc_i=escloc_i+expfac
6621 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6625 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6626 & +gaussc(k,2,j,it))*expfac
6633 dersc(1)=dersc(1)/cos(theti)**2
6634 ddersc(1)=ddersc(1)/cos(theti)**2
6637 escloci=-(dlog(escloc_i)-emin)
6639 dersc(j)=dersc(j)/escloc_i
6643 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6648 C------------------------------------------------------------------------------
6649 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6650 implicit real*8 (a-h,o-z)
6651 include 'DIMENSIONS'
6652 include 'COMMON.GEO'
6653 include 'COMMON.LOCAL'
6654 include 'COMMON.IOUNITS'
6655 common /sccalc/ time11,time12,time112,theti,it,nlobit
6656 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6657 double precision contr(maxlob)
6668 z(k)=x(k)-censc(k,j,it)
6674 Axk=Axk+gaussc(l,k,j,it)*z(l)
6680 expfac=expfac+Ax(k,j)*z(k)
6685 C As in the case of ebend, we want to avoid underflows in exponentiation and
6686 C subsequent NaNs and INFs in energy calculation.
6687 C Find the largest exponent
6690 if (emin.gt.contr(j)) emin=contr(j)
6694 C Compute the contribution to SC energy and derivatives
6698 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6699 escloc_i=escloc_i+expfac
6701 dersc(k)=dersc(k)+Ax(k,j)*expfac
6703 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6704 & +gaussc(1,2,j,it))*expfac
6708 dersc(1)=dersc(1)/cos(theti)**2
6709 dersc12=dersc12/cos(theti)**2
6710 escloci=-(dlog(escloc_i)-emin)
6712 dersc(j)=dersc(j)/escloc_i
6714 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6718 c----------------------------------------------------------------------------------
6719 subroutine esc(escloc)
6720 C Calculate the local energy of a side chain and its derivatives in the
6721 C corresponding virtual-bond valence angles THETA and the spherical angles
6722 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6723 C added by Urszula Kozlowska. 07/11/2007
6725 implicit real*8 (a-h,o-z)
6726 include 'DIMENSIONS'
6727 include 'COMMON.GEO'
6728 include 'COMMON.LOCAL'
6729 include 'COMMON.VAR'
6730 include 'COMMON.SCROT'
6731 include 'COMMON.INTERACT'
6732 include 'COMMON.DERIV'
6733 include 'COMMON.CHAIN'
6734 include 'COMMON.IOUNITS'
6735 include 'COMMON.NAMES'
6736 include 'COMMON.FFIELD'
6737 include 'COMMON.CONTROL'
6738 include 'COMMON.VECTORS'
6739 double precision x_prime(3),y_prime(3),z_prime(3)
6740 & , sumene,dsc_i,dp2_i,x(65),
6741 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6742 & de_dxx,de_dyy,de_dzz,de_dt
6743 double precision s1_t,s1_6_t,s2_t,s2_6_t
6745 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6746 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6747 & dt_dCi(3),dt_dCi1(3)
6748 common /sccalc/ time11,time12,time112,theti,it,nlobit
6751 do i=loc_start,loc_end
6752 if (itype(i).eq.ntyp1) cycle
6753 costtab(i+1) =dcos(theta(i+1))
6754 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6755 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6756 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6757 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6758 cosfac=dsqrt(cosfac2)
6759 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6760 sinfac=dsqrt(sinfac2)
6762 if (it.eq.10) goto 1
6764 C Compute the axes of tghe local cartesian coordinates system; store in
6765 c x_prime, y_prime and z_prime
6772 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6773 C & dc_norm(3,i+nres)
6775 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6776 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6779 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6782 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6783 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6784 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6785 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6786 c & " xy",scalar(x_prime(1),y_prime(1)),
6787 c & " xz",scalar(x_prime(1),z_prime(1)),
6788 c & " yy",scalar(y_prime(1),y_prime(1)),
6789 c & " yz",scalar(y_prime(1),z_prime(1)),
6790 c & " zz",scalar(z_prime(1),z_prime(1))
6792 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6793 C to local coordinate system. Store in xx, yy, zz.
6799 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6800 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6801 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6808 C Compute the energy of the ith side cbain
6810 c write (2,*) "xx",xx," yy",yy," zz",zz
6813 x(j) = sc_parmin(j,it)
6816 Cc diagnostics - remove later
6818 yy1 = dsin(alph(2))*dcos(omeg(2))
6819 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6820 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6821 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6823 C," --- ", xx_w,yy_w,zz_w
6826 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6827 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6829 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6830 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6832 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6833 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6834 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6835 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6836 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6838 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6839 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6840 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6841 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6842 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6844 dsc_i = 0.743d0+x(61)
6846 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6847 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6848 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6849 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6850 s1=(1+x(63))/(0.1d0 + dscp1)
6851 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6852 s2=(1+x(65))/(0.1d0 + dscp2)
6853 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6854 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6855 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6856 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6858 c & dscp1,dscp2,sumene
6859 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6860 escloc = escloc + sumene
6861 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6866 C This section to check the numerical derivatives of the energy of ith side
6867 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6868 C #define DEBUG in the code to turn it on.
6870 write (2,*) "sumene =",sumene
6874 write (2,*) xx,yy,zz
6875 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6876 de_dxx_num=(sumenep-sumene)/aincr
6878 write (2,*) "xx+ sumene from enesc=",sumenep
6881 write (2,*) xx,yy,zz
6882 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6883 de_dyy_num=(sumenep-sumene)/aincr
6885 write (2,*) "yy+ sumene from enesc=",sumenep
6888 write (2,*) xx,yy,zz
6889 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6890 de_dzz_num=(sumenep-sumene)/aincr
6892 write (2,*) "zz+ sumene from enesc=",sumenep
6893 costsave=cost2tab(i+1)
6894 sintsave=sint2tab(i+1)
6895 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6896 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6897 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6898 de_dt_num=(sumenep-sumene)/aincr
6899 write (2,*) " t+ sumene from enesc=",sumenep
6900 cost2tab(i+1)=costsave
6901 sint2tab(i+1)=sintsave
6902 C End of diagnostics section.
6905 C Compute the gradient of esc
6907 c zz=zz*dsign(1.0,dfloat(itype(i)))
6908 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6909 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6910 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6911 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6912 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6913 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6914 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6915 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6916 pom1=(sumene3*sint2tab(i+1)+sumene1)
6917 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6918 pom2=(sumene4*cost2tab(i+1)+sumene2)
6919 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6920 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6921 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6922 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6924 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6925 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6926 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6928 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6929 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6930 & +(pom1+pom2)*pom_dx
6932 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6935 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6936 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6937 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6939 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6940 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6941 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6942 & +x(59)*zz**2 +x(60)*xx*zz
6943 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6944 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6945 & +(pom1-pom2)*pom_dy
6947 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6950 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6951 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6952 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6953 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6954 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6955 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6956 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6957 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6959 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6962 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6963 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6964 & +pom1*pom_dt1+pom2*pom_dt2
6966 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6971 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6972 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6973 cosfac2xx=cosfac2*xx
6974 sinfac2yy=sinfac2*yy
6976 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6978 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6980 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6981 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6982 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6983 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6984 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6985 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6986 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6987 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6988 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6989 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6993 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6994 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6995 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6996 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6999 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
7000 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
7001 dZZ_XYZ(k)=vbld_inv(i+nres)*
7002 & (z_prime(k)-zz*dC_norm(k,i+nres))
7004 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
7005 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
7009 dXX_Ctab(k,i)=dXX_Ci(k)
7010 dXX_C1tab(k,i)=dXX_Ci1(k)
7011 dYY_Ctab(k,i)=dYY_Ci(k)
7012 dYY_C1tab(k,i)=dYY_Ci1(k)
7013 dZZ_Ctab(k,i)=dZZ_Ci(k)
7014 dZZ_C1tab(k,i)=dZZ_Ci1(k)
7015 dXX_XYZtab(k,i)=dXX_XYZ(k)
7016 dYY_XYZtab(k,i)=dYY_XYZ(k)
7017 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
7021 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
7022 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
7023 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
7024 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
7025 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
7027 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
7028 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
7029 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
7030 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
7031 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
7032 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
7033 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
7034 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
7036 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
7037 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
7039 C to check gradient call subroutine check_grad
7045 c------------------------------------------------------------------------------
7046 double precision function enesc(x,xx,yy,zz,cost2,sint2)
7048 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
7049 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
7050 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7051 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7053 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7054 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7056 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7057 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7058 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7059 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7060 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7062 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7063 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7064 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7065 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7066 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7068 dsc_i = 0.743d0+x(61)
7070 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7071 & *(xx*cost2+yy*sint2))
7072 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7073 & *(xx*cost2-yy*sint2))
7074 s1=(1+x(63))/(0.1d0 + dscp1)
7075 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7076 s2=(1+x(65))/(0.1d0 + dscp2)
7077 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7078 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
7079 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
7084 c------------------------------------------------------------------------------
7085 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
7087 C This procedure calculates two-body contact function g(rij) and its derivative:
7090 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
7093 C where x=(rij-r0ij)/delta
7095 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
7098 double precision rij,r0ij,eps0ij,fcont,fprimcont
7099 double precision x,x2,x4,delta
7103 if (x.lt.-1.0D0) then
7106 else if (x.le.1.0D0) then
7109 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
7110 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7117 c------------------------------------------------------------------------------
7118 subroutine splinthet(theti,delta,ss,ssder)
7119 implicit real*8 (a-h,o-z)
7120 include 'DIMENSIONS'
7121 include 'COMMON.VAR'
7122 include 'COMMON.GEO'
7125 if (theti.gt.pipol) then
7126 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7128 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7133 c------------------------------------------------------------------------------
7134 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7136 double precision x,x0,delta,f0,f1,fprim0,f,fprim
7137 double precision ksi,ksi2,ksi3,a1,a2,a3
7138 a1=fprim0*delta/(f1-f0)
7144 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7145 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7148 c------------------------------------------------------------------------------
7149 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7151 double precision x,x0,delta,f0x,f1x,fprim0x,fx
7152 double precision ksi,ksi2,ksi3,a1,a2,a3
7157 a2=3*(f1x-f0x)-2*fprim0x*delta
7158 a3=fprim0x*delta-2*(f1x-f0x)
7159 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7162 C-----------------------------------------------------------------------------
7164 C-----------------------------------------------------------------------------
7165 subroutine etor(etors,edihcnstr)
7166 implicit real*8 (a-h,o-z)
7167 include 'DIMENSIONS'
7168 include 'COMMON.VAR'
7169 include 'COMMON.GEO'
7170 include 'COMMON.LOCAL'
7171 include 'COMMON.TORSION'
7172 include 'COMMON.INTERACT'
7173 include 'COMMON.DERIV'
7174 include 'COMMON.CHAIN'
7175 include 'COMMON.NAMES'
7176 include 'COMMON.IOUNITS'
7177 include 'COMMON.FFIELD'
7178 include 'COMMON.TORCNSTR'
7179 include 'COMMON.CONTROL'
7181 C Set lprn=.true. for debugging
7185 do i=iphi_start,iphi_end
7187 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7188 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7189 itori=itortyp(itype(i-2))
7190 itori1=itortyp(itype(i-1))
7193 C Proline-Proline pair is a special case...
7194 if (itori.eq.3 .and. itori1.eq.3) then
7195 if (phii.gt.-dwapi3) then
7197 fac=1.0D0/(1.0D0-cosphi)
7198 etorsi=v1(1,3,3)*fac
7199 etorsi=etorsi+etorsi
7200 etors=etors+etorsi-v1(1,3,3)
7201 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
7202 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7205 v1ij=v1(j+1,itori,itori1)
7206 v2ij=v2(j+1,itori,itori1)
7209 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7210 if (energy_dec) etors_ii=etors_ii+
7211 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7212 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7216 v1ij=v1(j,itori,itori1)
7217 v2ij=v2(j,itori,itori1)
7220 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7221 if (energy_dec) etors_ii=etors_ii+
7222 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7223 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7226 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7229 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7230 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7231 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7232 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7233 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7235 ! 6/20/98 - dihedral angle constraints
7238 itori=idih_constr(i)
7241 if (difi.gt.drange(i)) then
7243 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7244 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7245 else if (difi.lt.-drange(i)) then
7247 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
7248 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7250 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
7251 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7253 ! write (iout,*) 'edihcnstr',edihcnstr
7256 c------------------------------------------------------------------------------
7257 subroutine etor_d(etors_d)
7261 c----------------------------------------------------------------------------
7263 subroutine etor(etors,edihcnstr)
7264 implicit real*8 (a-h,o-z)
7265 include 'DIMENSIONS'
7266 include 'COMMON.VAR'
7267 include 'COMMON.GEO'
7268 include 'COMMON.LOCAL'
7269 include 'COMMON.TORSION'
7270 include 'COMMON.INTERACT'
7271 include 'COMMON.DERIV'
7272 include 'COMMON.CHAIN'
7273 include 'COMMON.NAMES'
7274 include 'COMMON.IOUNITS'
7275 include 'COMMON.FFIELD'
7276 include 'COMMON.TORCNSTR'
7277 include 'COMMON.CONTROL'
7279 C Set lprn=.true. for debugging
7283 do i=iphi_start,iphi_end
7284 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7285 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7286 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7287 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7288 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7289 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7290 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7291 C For introducing the NH3+ and COO- group please check the etor_d for reference
7294 if (iabs(itype(i)).eq.20) then
7299 itori=itortyp(itype(i-2))
7300 itori1=itortyp(itype(i-1))
7303 C Regular cosine and sine terms
7304 do j=1,nterm(itori,itori1,iblock)
7305 v1ij=v1(j,itori,itori1,iblock)
7306 v2ij=v2(j,itori,itori1,iblock)
7309 etors=etors+v1ij*cosphi+v2ij*sinphi
7310 if (energy_dec) etors_ii=etors_ii+
7311 & v1ij*cosphi+v2ij*sinphi
7312 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7316 C E = SUM ----------------------------------- - v1
7317 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7319 cosphi=dcos(0.5d0*phii)
7320 sinphi=dsin(0.5d0*phii)
7321 do j=1,nlor(itori,itori1,iblock)
7322 vl1ij=vlor1(j,itori,itori1)
7323 vl2ij=vlor2(j,itori,itori1)
7324 vl3ij=vlor3(j,itori,itori1)
7325 pom=vl2ij*cosphi+vl3ij*sinphi
7326 pom1=1.0d0/(pom*pom+1.0d0)
7327 etors=etors+vl1ij*pom1
7328 if (energy_dec) etors_ii=etors_ii+
7331 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7333 C Subtract the constant term
7334 etors=etors-v0(itori,itori1,iblock)
7335 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7336 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
7338 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7339 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7340 & (v1(j,itori,itori1,iblock),j=1,6),
7341 & (v2(j,itori,itori1,iblock),j=1,6)
7342 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7343 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7345 ! 6/20/98 - dihedral angle constraints
7347 c do i=1,ndih_constr
7348 do i=idihconstr_start,idihconstr_end
7349 itori=idih_constr(i)
7351 difi=pinorm(phii-phi0(i))
7352 if (difi.gt.drange(i)) then
7354 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7355 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7356 else if (difi.lt.-drange(i)) then
7358 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7359 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7363 if (energy_dec) then
7364 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
7365 & i,itori,rad2deg*phii,
7366 & rad2deg*phi0(i), rad2deg*drange(i),
7367 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
7370 cd write (iout,*) 'edihcnstr',edihcnstr
7373 c----------------------------------------------------------------------------
7374 subroutine etor_d(etors_d)
7375 C 6/23/01 Compute double torsional energy
7376 implicit real*8 (a-h,o-z)
7377 include 'DIMENSIONS'
7378 include 'COMMON.VAR'
7379 include 'COMMON.GEO'
7380 include 'COMMON.LOCAL'
7381 include 'COMMON.TORSION'
7382 include 'COMMON.INTERACT'
7383 include 'COMMON.DERIV'
7384 include 'COMMON.CHAIN'
7385 include 'COMMON.NAMES'
7386 include 'COMMON.IOUNITS'
7387 include 'COMMON.FFIELD'
7388 include 'COMMON.TORCNSTR'
7390 C Set lprn=.true. for debugging
7394 c write(iout,*) "a tu??"
7395 do i=iphid_start,iphid_end
7396 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7397 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7398 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7399 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7400 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7401 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7402 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7403 & (itype(i+1).eq.ntyp1)) cycle
7404 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7405 itori=itortyp(itype(i-2))
7406 itori1=itortyp(itype(i-1))
7407 itori2=itortyp(itype(i))
7413 if (iabs(itype(i+1)).eq.20) iblock=2
7414 C Iblock=2 Proline type
7415 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7416 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7417 C if (itype(i+1).eq.ntyp1) iblock=3
7418 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7419 C IS or IS NOT need for this
7420 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7421 C is (itype(i-3).eq.ntyp1) ntblock=2
7422 C ntblock is N-terminal blocking group
7424 C Regular cosine and sine terms
7425 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7426 C Example of changes for NH3+ blocking group
7427 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7428 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7429 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7430 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7431 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7432 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7433 cosphi1=dcos(j*phii)
7434 sinphi1=dsin(j*phii)
7435 cosphi2=dcos(j*phii1)
7436 sinphi2=dsin(j*phii1)
7437 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7438 & v2cij*cosphi2+v2sij*sinphi2
7439 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7440 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7442 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7444 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7445 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7446 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7447 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7448 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7449 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7450 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7451 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7452 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7453 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7454 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7455 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7456 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7457 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7460 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7461 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7466 C----------------------------------------------------------------------------------
7467 C The rigorous attempt to derive energy function
7468 subroutine etor_kcc(etors,edihcnstr)
7469 implicit real*8 (a-h,o-z)
7470 include 'DIMENSIONS'
7471 include 'COMMON.VAR'
7472 include 'COMMON.GEO'
7473 include 'COMMON.LOCAL'
7474 include 'COMMON.TORSION'
7475 include 'COMMON.INTERACT'
7476 include 'COMMON.DERIV'
7477 include 'COMMON.CHAIN'
7478 include 'COMMON.NAMES'
7479 include 'COMMON.IOUNITS'
7480 include 'COMMON.FFIELD'
7481 include 'COMMON.TORCNSTR'
7482 include 'COMMON.CONTROL'
7484 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
7485 C Set lprn=.true. for debugging
7488 C print *,"wchodze kcc"
7489 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
7490 if (tor_mode.ne.2) then
7493 do i=iphi_start,iphi_end
7494 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7495 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7496 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7497 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7498 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7499 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7500 itori=itortyp_kcc(itype(i-2))
7501 itori1=itortyp_kcc(itype(i-1))
7506 sumnonchebyshev=0.0d0
7508 C to avoid multiple devision by 2
7509 c theti22=0.5d0*theta(i)
7510 C theta 12 is the theta_1 /2
7511 C theta 22 is theta_2 /2
7512 c theti12=0.5d0*theta(i-1)
7513 C and appropriate sinus function
7514 sinthet1=dsin(theta(i-1))
7515 sinthet2=dsin(theta(i))
7516 costhet1=dcos(theta(i-1))
7517 costhet2=dcos(theta(i))
7518 c Cosines of halves thetas
7519 costheti12=0.5d0*(1.0d0+costhet1)
7520 costheti22=0.5d0*(1.0d0+costhet2)
7521 C to speed up lets store its mutliplication
7522 sint1t2=sinthet2*sinthet1
7524 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
7525 C +d_n*sin(n*gamma)) *
7526 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
7527 C we have two sum 1) Non-Chebyshev which is with n and gamma
7529 do j=1,nterm_kcc(itori,itori1)
7531 nval=nterm_kcc_Tb(itori,itori1)
7532 v1ij=v1_kcc(j,itori,itori1)
7533 v2ij=v2_kcc(j,itori,itori1)
7534 c write (iout,*) "i",i," j",j," v1",v1ij," v2",v2ij
7535 C v1ij is c_n and d_n in euation above
7539 sint1t2n=sint1t2n*sint1t2
7540 sumth1tyb1=tschebyshev(1,nval,v11_chyb(1,j,itori,itori1),
7542 gradth1tyb1=-0.5d0*sinthet1*gradtschebyshev(0,nval-1,
7543 & v11_chyb(1,j,itori,itori1),costheti12)
7544 c write (iout,*) "v11",(v11_chyb(k,j,itori,itori1),k=1,nval),
7545 c & " sumth1tyb1",sumth1tyb1," gradth1tyb1",gradth1tyb1
7546 sumth2tyb1=tschebyshev(1,nval,v21_chyb(1,j,itori,itori1),
7548 gradth2tyb1=-0.5d0*sinthet2*gradtschebyshev(0,nval-1,
7549 & v21_chyb(1,j,itori,itori1),costheti22)
7550 c write (iout,*) "v21",(v21_chyb(k,j,itori,itori1),k=1,nval),
7551 c & " sumth2tyb1",sumth2tyb1," gradth2tyb1",gradth2tyb1
7552 sumth1tyb2=tschebyshev(1,nval,v12_chyb(1,j,itori,itori1),
7554 gradth1tyb2=-0.5d0*sinthet1*gradtschebyshev(0,nval-1,
7555 & v12_chyb(1,j,itori,itori1),costheti12)
7556 c write (iout,*) "v12",(v12_chyb(k,j,itori,itori1),k=1,nval),
7557 c & " sumth1tyb2",sumth1tyb2," gradth1tyb2",gradth1tyb2
7558 sumth2tyb2=tschebyshev(1,nval,v22_chyb(1,j,itori,itori1),
7560 gradth2tyb2=-0.5d0*sinthet2*gradtschebyshev(0,nval-1,
7561 & v22_chyb(1,j,itori,itori1),costheti22)
7562 c write (iout,*) "v22",(v22_chyb(k,j,itori,itori1),k=1,nval),
7563 c & " sumth2tyb2",sumth2tyb2," gradth2tyb2",gradth2tyb2
7564 C etors=etors+sint1t2n*(v1ij*cosphi+v2ij*sinphi)
7565 C if (energy_dec) etors_ii=etors_ii+
7566 C & v1ij*cosphi+v2ij*sinphi
7567 C glocig is the gradient local i site in gamma
7568 actval1=v1ij*cosphi*(1.0d0+sumth1tyb1+sumth2tyb1)
7569 actval2=v2ij*sinphi*(1.0d0+sumth1tyb2+sumth2tyb2)
7570 etori=etori+sint1t2n*(actval1+actval2)
7572 & j*sint1t2n*(v2ij*cosphi*(1.0d0+sumth1tyb2+sumth2tyb2)
7573 & -v1ij*sinphi*(1.0d0+sumth1tyb1+sumth2tyb1))
7574 C now gradient over theta_1
7576 & j*sint1t2n1*costhet1*sinthet2*(actval1+actval2)+
7577 & sint1t2n*(v1ij*cosphi*gradth1tyb1+v2ij*sinphi*gradth1tyb2)
7579 & j*sint1t2n1*sinthet1*costhet2*(actval1+actval2)+
7580 & sint1t2n*(v1ij*cosphi*gradth2tyb1+v2ij*sinphi*gradth2tyb2)
7582 C now the Czebyshev polinominal sum
7583 c do k=1,nterm_kcc_Tb(itori,itori1)
7584 c thybt1(k)=v1_chyb(k,j,itori,itori1)
7585 c thybt2(k)=v2_chyb(k,j,itori,itori1)
7589 C print *, sumth1thyb, gradthybt1, sumth2thyb, gradthybt2,
7591 C & (0,nterm_kcc_Tb(itori,itori1)-1,thybt2(1),
7592 C & dcos(theti22)**2),
7595 C now overal sumation
7596 C print *,"sumnon", sumnonchebyshev,sumth1thyb+sumth2thyb
7599 C derivative over gamma
7600 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
7601 C derivative over theta1
7602 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
7603 C now derivative over theta2
7604 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
7606 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
7607 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
7609 C gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7610 ! 6/20/98 - dihedral angle constraints
7611 if (tor_mode.ne.2) then
7613 c do i=1,ndih_constr
7614 do i=idihconstr_start,idihconstr_end
7615 itori=idih_constr(i)
7617 difi=pinorm(phii-phi0(i))
7618 if (difi.gt.drange(i)) then
7620 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7621 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7622 else if (difi.lt.-drange(i)) then
7624 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7625 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7634 C The rigorous attempt to derive energy function
7635 subroutine ebend_kcc(etheta,ethetacnstr)
7637 implicit real*8 (a-h,o-z)
7638 include 'DIMENSIONS'
7639 include 'COMMON.VAR'
7640 include 'COMMON.GEO'
7641 include 'COMMON.LOCAL'
7642 include 'COMMON.TORSION'
7643 include 'COMMON.INTERACT'
7644 include 'COMMON.DERIV'
7645 include 'COMMON.CHAIN'
7646 include 'COMMON.NAMES'
7647 include 'COMMON.IOUNITS'
7648 include 'COMMON.FFIELD'
7649 include 'COMMON.TORCNSTR'
7650 include 'COMMON.CONTROL'
7652 double precision thybt1(maxtermkcc)
7653 C Set lprn=.true. for debugging
7656 C print *,"wchodze kcc"
7657 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
7658 if (tor_mode.ne.2) etheta=0.0D0
7659 do i=ithet_start,ithet_end
7660 c print *,i,itype(i-1),itype(i),itype(i-2)
7661 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
7662 & .or.itype(i).eq.ntyp1) cycle
7663 iti=itortyp_kcc(itype(i-1))
7664 sinthet=dsin(theta(i)/2.0d0)
7665 costhet=dcos(theta(i)/2.0d0)
7666 do j=1,nbend_kcc_Tb(iti)
7667 thybt1(j)=v1bend_chyb(j,iti)
7669 sumth1thyb=tschebyshev
7670 & (1,nbend_kcc_Tb(iti),thybt1(1),costhet)
7671 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
7673 ihelp=nbend_kcc_Tb(iti)-1
7674 gradthybt1=gradtschebyshev
7675 & (0,ihelp,thybt1(1),costhet)
7676 etheta=etheta+sumth1thyb
7677 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
7678 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*
7679 & gradthybt1*sinthet*(-0.5d0)
7681 if (tor_mode.ne.2) then
7683 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
7684 do i=ithetaconstr_start,ithetaconstr_end
7685 itheta=itheta_constr(i)
7686 thetiii=theta(itheta)
7687 difi=pinorm(thetiii-theta_constr0(i))
7688 if (difi.gt.theta_drange(i)) then
7689 difi=difi-theta_drange(i)
7690 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7691 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7692 & +for_thet_constr(i)*difi**3
7693 else if (difi.lt.-drange(i)) then
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
7701 if (energy_dec) then
7702 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
7703 & i,itheta,rad2deg*thetiii,
7704 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
7705 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
7706 & gloc(itheta+nphi-2,icg)
7712 c------------------------------------------------------------------------------
7713 subroutine eback_sc_corr(esccor)
7714 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7715 c conformational states; temporarily implemented as differences
7716 c between UNRES torsional potentials (dependent on three types of
7717 c residues) and the torsional potentials dependent on all 20 types
7718 c of residues computed from AM1 energy surfaces of terminally-blocked
7719 c amino-acid residues.
7720 implicit real*8 (a-h,o-z)
7721 include 'DIMENSIONS'
7722 include 'COMMON.VAR'
7723 include 'COMMON.GEO'
7724 include 'COMMON.LOCAL'
7725 include 'COMMON.TORSION'
7726 include 'COMMON.SCCOR'
7727 include 'COMMON.INTERACT'
7728 include 'COMMON.DERIV'
7729 include 'COMMON.CHAIN'
7730 include 'COMMON.NAMES'
7731 include 'COMMON.IOUNITS'
7732 include 'COMMON.FFIELD'
7733 include 'COMMON.CONTROL'
7735 C Set lprn=.true. for debugging
7738 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7740 do i=itau_start,itau_end
7741 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7743 isccori=isccortyp(itype(i-2))
7744 isccori1=isccortyp(itype(i-1))
7745 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7747 do intertyp=1,3 !intertyp
7748 cc Added 09 May 2012 (Adasko)
7749 cc Intertyp means interaction type of backbone mainchain correlation:
7750 c 1 = SC...Ca...Ca...Ca
7751 c 2 = Ca...Ca...Ca...SC
7752 c 3 = SC...Ca...Ca...SCi
7754 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7755 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7756 & (itype(i-1).eq.ntyp1)))
7757 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7758 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7759 & .or.(itype(i).eq.ntyp1)))
7760 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7761 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7762 & (itype(i-3).eq.ntyp1)))) cycle
7763 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7764 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7766 do j=1,nterm_sccor(isccori,isccori1)
7767 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7768 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7769 cosphi=dcos(j*tauangle(intertyp,i))
7770 sinphi=dsin(j*tauangle(intertyp,i))
7771 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7772 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7774 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7775 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7777 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7778 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
7779 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
7780 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7781 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7787 c----------------------------------------------------------------------------
7788 subroutine multibody(ecorr)
7789 C This subroutine calculates multi-body contributions to energy following
7790 C the idea of Skolnick et al. If side chains I and J make a contact and
7791 C at the same time side chains I+1 and J+1 make a contact, an extra
7792 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7793 implicit real*8 (a-h,o-z)
7794 include 'DIMENSIONS'
7795 include 'COMMON.IOUNITS'
7796 include 'COMMON.DERIV'
7797 include 'COMMON.INTERACT'
7798 include 'COMMON.CONTACTS'
7799 double precision gx(3),gx1(3)
7802 C Set lprn=.true. for debugging
7806 write (iout,'(a)') 'Contact function values:'
7808 write (iout,'(i2,20(1x,i2,f10.5))')
7809 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7824 num_conti=num_cont(i)
7825 num_conti1=num_cont(i1)
7830 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7831 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7832 cd & ' ishift=',ishift
7833 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7834 C The system gains extra energy.
7835 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7836 endif ! j1==j+-ishift
7845 c------------------------------------------------------------------------------
7846 double precision function esccorr(i,j,k,l,jj,kk)
7847 implicit real*8 (a-h,o-z)
7848 include 'DIMENSIONS'
7849 include 'COMMON.IOUNITS'
7850 include 'COMMON.DERIV'
7851 include 'COMMON.INTERACT'
7852 include 'COMMON.CONTACTS'
7853 include 'COMMON.SHIELD'
7854 double precision gx(3),gx1(3)
7859 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7860 C Calculate the multi-body contribution to energy.
7861 C Calculate multi-body contributions to the gradient.
7862 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7863 cd & k,l,(gacont(m,kk,k),m=1,3)
7865 gx(m) =ekl*gacont(m,jj,i)
7866 gx1(m)=eij*gacont(m,kk,k)
7867 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7868 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7869 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7870 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7874 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7879 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7885 c------------------------------------------------------------------------------
7886 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7887 C This subroutine calculates multi-body contributions to hydrogen-bonding
7888 implicit real*8 (a-h,o-z)
7889 include 'DIMENSIONS'
7890 include 'COMMON.IOUNITS'
7893 parameter (max_cont=maxconts)
7894 parameter (max_dim=26)
7895 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7896 double precision zapas(max_dim,maxconts,max_fg_procs),
7897 & zapas_recv(max_dim,maxconts,max_fg_procs)
7898 common /przechowalnia/ zapas
7899 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7900 & status_array(MPI_STATUS_SIZE,maxconts*2)
7902 include 'COMMON.SETUP'
7903 include 'COMMON.FFIELD'
7904 include 'COMMON.DERIV'
7905 include 'COMMON.INTERACT'
7906 include 'COMMON.CONTACTS'
7907 include 'COMMON.CONTROL'
7908 include 'COMMON.LOCAL'
7909 double precision gx(3),gx1(3),time00
7912 C Set lprn=.true. for debugging
7917 if (nfgtasks.le.1) goto 30
7919 write (iout,'(a)') 'Contact function values before RECEIVE:'
7921 write (iout,'(2i3,50(1x,i2,f5.2))')
7922 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7923 & j=1,num_cont_hb(i))
7927 do i=1,ntask_cont_from
7930 do i=1,ntask_cont_to
7933 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7935 C Make the list of contacts to send to send to other procesors
7936 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7938 do i=iturn3_start,iturn3_end
7939 c write (iout,*) "make contact list turn3",i," num_cont",
7941 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7943 do i=iturn4_start,iturn4_end
7944 c write (iout,*) "make contact list turn4",i," num_cont",
7946 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7950 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7952 do j=1,num_cont_hb(i)
7955 iproc=iint_sent_local(k,jjc,ii)
7956 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7957 if (iproc.gt.0) then
7958 ncont_sent(iproc)=ncont_sent(iproc)+1
7959 nn=ncont_sent(iproc)
7961 zapas(2,nn,iproc)=jjc
7962 zapas(3,nn,iproc)=facont_hb(j,i)
7963 zapas(4,nn,iproc)=ees0p(j,i)
7964 zapas(5,nn,iproc)=ees0m(j,i)
7965 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7966 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7967 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7968 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7969 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7970 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7971 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7972 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7973 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7974 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7975 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7976 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7977 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7978 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7979 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7980 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7981 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7982 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7983 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7984 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7985 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7992 & "Numbers of contacts to be sent to other processors",
7993 & (ncont_sent(i),i=1,ntask_cont_to)
7994 write (iout,*) "Contacts sent"
7995 do ii=1,ntask_cont_to
7997 iproc=itask_cont_to(ii)
7998 write (iout,*) nn," contacts to processor",iproc,
7999 & " of CONT_TO_COMM group"
8001 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8009 CorrelID1=nfgtasks+fg_rank+1
8011 C Receive the numbers of needed contacts from other processors
8012 do ii=1,ntask_cont_from
8013 iproc=itask_cont_from(ii)
8015 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8016 & FG_COMM,req(ireq),IERR)
8018 c write (iout,*) "IRECV ended"
8020 C Send the number of contacts needed by other processors
8021 do ii=1,ntask_cont_to
8022 iproc=itask_cont_to(ii)
8024 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8025 & FG_COMM,req(ireq),IERR)
8027 c write (iout,*) "ISEND ended"
8028 c write (iout,*) "number of requests (nn)",ireq
8031 & call MPI_Waitall(ireq,req,status_array,ierr)
8033 c & "Numbers of contacts to be received from other processors",
8034 c & (ncont_recv(i),i=1,ntask_cont_from)
8038 do ii=1,ntask_cont_from
8039 iproc=itask_cont_from(ii)
8041 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8042 c & " of CONT_TO_COMM group"
8046 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8047 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8048 c write (iout,*) "ireq,req",ireq,req(ireq)
8051 C Send the contacts to processors that need them
8052 do ii=1,ntask_cont_to
8053 iproc=itask_cont_to(ii)
8055 c write (iout,*) nn," contacts to processor",iproc,
8056 c & " of CONT_TO_COMM group"
8059 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8060 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8061 c write (iout,*) "ireq,req",ireq,req(ireq)
8063 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8067 c write (iout,*) "number of requests (contacts)",ireq
8068 c write (iout,*) "req",(req(i),i=1,4)
8071 & call MPI_Waitall(ireq,req,status_array,ierr)
8072 do iii=1,ntask_cont_from
8073 iproc=itask_cont_from(iii)
8076 write (iout,*) "Received",nn," contacts from processor",iproc,
8077 & " of CONT_FROM_COMM group"
8080 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8085 ii=zapas_recv(1,i,iii)
8086 c Flag the received contacts to prevent double-counting
8087 jj=-zapas_recv(2,i,iii)
8088 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8090 nnn=num_cont_hb(ii)+1
8093 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8094 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8095 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8096 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8097 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8098 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8099 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8100 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8101 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8102 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8103 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8104 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8105 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8106 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8107 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8108 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8109 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8110 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8111 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8112 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8113 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8114 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8115 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8116 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8121 write (iout,'(a)') 'Contact function values after receive:'
8123 write (iout,'(2i3,50(1x,i3,f5.2))')
8124 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8125 & j=1,num_cont_hb(i))
8132 write (iout,'(a)') 'Contact function values:'
8134 write (iout,'(2i3,50(1x,i3,f5.2))')
8135 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8136 & j=1,num_cont_hb(i))
8140 C Remove the loop below after debugging !!!
8147 C Calculate the local-electrostatic correlation terms
8148 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8150 num_conti=num_cont_hb(i)
8151 num_conti1=num_cont_hb(i+1)
8158 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8159 c & ' jj=',jj,' kk=',kk
8160 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8161 & .or. j.lt.0 .and. j1.gt.0) .and.
8162 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8163 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8164 C The system gains extra energy.
8165 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8166 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
8167 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
8169 else if (j1.eq.j) then
8170 C Contacts I-J and I-(J+1) occur simultaneously.
8171 C The system loses extra energy.
8172 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8177 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8178 c & ' jj=',jj,' kk=',kk
8180 C Contacts I-J and (I+1)-J occur simultaneously.
8181 C The system loses extra energy.
8182 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8189 c------------------------------------------------------------------------------
8190 subroutine add_hb_contact(ii,jj,itask)
8191 implicit real*8 (a-h,o-z)
8192 include "DIMENSIONS"
8193 include "COMMON.IOUNITS"
8196 parameter (max_cont=maxconts)
8197 parameter (max_dim=26)
8198 include "COMMON.CONTACTS"
8199 double precision zapas(max_dim,maxconts,max_fg_procs),
8200 & zapas_recv(max_dim,maxconts,max_fg_procs)
8201 common /przechowalnia/ zapas
8202 integer i,j,ii,jj,iproc,itask(4),nn
8203 c write (iout,*) "itask",itask
8206 if (iproc.gt.0) then
8207 do j=1,num_cont_hb(ii)
8209 c write (iout,*) "i",ii," j",jj," jjc",jjc
8211 ncont_sent(iproc)=ncont_sent(iproc)+1
8212 nn=ncont_sent(iproc)
8213 zapas(1,nn,iproc)=ii
8214 zapas(2,nn,iproc)=jjc
8215 zapas(3,nn,iproc)=facont_hb(j,ii)
8216 zapas(4,nn,iproc)=ees0p(j,ii)
8217 zapas(5,nn,iproc)=ees0m(j,ii)
8218 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8219 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8220 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8221 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8222 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8223 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8224 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8225 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8226 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8227 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8228 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8229 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8230 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8231 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8232 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8233 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8234 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8235 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8236 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8237 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8238 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8246 c------------------------------------------------------------------------------
8247 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8249 C This subroutine calculates multi-body contributions to hydrogen-bonding
8250 implicit real*8 (a-h,o-z)
8251 include 'DIMENSIONS'
8252 include 'COMMON.IOUNITS'
8255 parameter (max_cont=maxconts)
8256 parameter (max_dim=70)
8257 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8258 double precision zapas(max_dim,maxconts,max_fg_procs),
8259 & zapas_recv(max_dim,maxconts,max_fg_procs)
8260 common /przechowalnia/ zapas
8261 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8262 & status_array(MPI_STATUS_SIZE,maxconts*2)
8264 include 'COMMON.SETUP'
8265 include 'COMMON.FFIELD'
8266 include 'COMMON.DERIV'
8267 include 'COMMON.LOCAL'
8268 include 'COMMON.INTERACT'
8269 include 'COMMON.CONTACTS'
8270 include 'COMMON.CHAIN'
8271 include 'COMMON.CONTROL'
8272 include 'COMMON.SHIELD'
8273 double precision gx(3),gx1(3)
8274 integer num_cont_hb_old(maxres)
8276 double precision eello4,eello5,eelo6,eello_turn6
8277 external eello4,eello5,eello6,eello_turn6
8278 C Set lprn=.true. for debugging
8283 num_cont_hb_old(i)=num_cont_hb(i)
8287 if (nfgtasks.le.1) goto 30
8289 write (iout,'(a)') 'Contact function values before RECEIVE:'
8291 write (iout,'(2i3,50(1x,i2,f5.2))')
8292 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8293 & j=1,num_cont_hb(i))
8297 do i=1,ntask_cont_from
8300 do i=1,ntask_cont_to
8303 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8305 C Make the list of contacts to send to send to other procesors
8306 do i=iturn3_start,iturn3_end
8307 c write (iout,*) "make contact list turn3",i," num_cont",
8309 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8311 do i=iturn4_start,iturn4_end
8312 c write (iout,*) "make contact list turn4",i," num_cont",
8314 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8318 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8320 do j=1,num_cont_hb(i)
8323 iproc=iint_sent_local(k,jjc,ii)
8324 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8325 if (iproc.ne.0) then
8326 ncont_sent(iproc)=ncont_sent(iproc)+1
8327 nn=ncont_sent(iproc)
8329 zapas(2,nn,iproc)=jjc
8330 zapas(3,nn,iproc)=d_cont(j,i)
8334 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8339 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8347 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8358 & "Numbers of contacts to be sent to other processors",
8359 & (ncont_sent(i),i=1,ntask_cont_to)
8360 write (iout,*) "Contacts sent"
8361 do ii=1,ntask_cont_to
8363 iproc=itask_cont_to(ii)
8364 write (iout,*) nn," contacts to processor",iproc,
8365 & " of CONT_TO_COMM group"
8367 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8375 CorrelID1=nfgtasks+fg_rank+1
8377 C Receive the numbers of needed contacts from other processors
8378 do ii=1,ntask_cont_from
8379 iproc=itask_cont_from(ii)
8381 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8382 & FG_COMM,req(ireq),IERR)
8384 c write (iout,*) "IRECV ended"
8386 C Send the number of contacts needed by other processors
8387 do ii=1,ntask_cont_to
8388 iproc=itask_cont_to(ii)
8390 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8391 & FG_COMM,req(ireq),IERR)
8393 c write (iout,*) "ISEND ended"
8394 c write (iout,*) "number of requests (nn)",ireq
8397 & call MPI_Waitall(ireq,req,status_array,ierr)
8399 c & "Numbers of contacts to be received from other processors",
8400 c & (ncont_recv(i),i=1,ntask_cont_from)
8404 do ii=1,ntask_cont_from
8405 iproc=itask_cont_from(ii)
8407 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8408 c & " of CONT_TO_COMM group"
8412 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8413 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8414 c write (iout,*) "ireq,req",ireq,req(ireq)
8417 C Send the contacts to processors that need them
8418 do ii=1,ntask_cont_to
8419 iproc=itask_cont_to(ii)
8421 c write (iout,*) nn," contacts to processor",iproc,
8422 c & " of CONT_TO_COMM group"
8425 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8426 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8427 c write (iout,*) "ireq,req",ireq,req(ireq)
8429 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8433 c write (iout,*) "number of requests (contacts)",ireq
8434 c write (iout,*) "req",(req(i),i=1,4)
8437 & call MPI_Waitall(ireq,req,status_array,ierr)
8438 do iii=1,ntask_cont_from
8439 iproc=itask_cont_from(iii)
8442 write (iout,*) "Received",nn," contacts from processor",iproc,
8443 & " of CONT_FROM_COMM group"
8446 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8451 ii=zapas_recv(1,i,iii)
8452 c Flag the received contacts to prevent double-counting
8453 jj=-zapas_recv(2,i,iii)
8454 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8456 nnn=num_cont_hb(ii)+1
8459 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8463 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8468 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8476 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8485 write (iout,'(a)') 'Contact function values after receive:'
8487 write (iout,'(2i3,50(1x,i3,5f6.3))')
8488 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8489 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8496 write (iout,'(a)') 'Contact function values:'
8498 write (iout,'(2i3,50(1x,i2,5f6.3))')
8499 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8500 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8506 C Remove the loop below after debugging !!!
8513 C Calculate the dipole-dipole interaction energies
8514 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8515 do i=iatel_s,iatel_e+1
8516 num_conti=num_cont_hb(i)
8525 C Calculate the local-electrostatic correlation terms
8526 c write (iout,*) "gradcorr5 in eello5 before loop"
8528 c write (iout,'(i5,3f10.5)')
8529 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8531 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8532 c write (iout,*) "corr loop i",i
8534 num_conti=num_cont_hb(i)
8535 num_conti1=num_cont_hb(i+1)
8542 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8543 c & ' jj=',jj,' kk=',kk
8544 c if (j1.eq.j+1 .or. j1.eq.j-1) then
8545 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8546 & .or. j.lt.0 .and. j1.gt.0) .and.
8547 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8548 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8549 C The system gains extra energy.
8551 sqd1=dsqrt(d_cont(jj,i))
8552 sqd2=dsqrt(d_cont(kk,i1))
8553 sred_geom = sqd1*sqd2
8554 IF (sred_geom.lt.cutoff_corr) THEN
8555 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
8557 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8558 cd & ' jj=',jj,' kk=',kk
8559 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8560 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8562 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8563 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8566 cd write (iout,*) 'sred_geom=',sred_geom,
8567 cd & ' ekont=',ekont,' fprim=',fprimcont,
8568 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8569 cd write (iout,*) "g_contij",g_contij
8570 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8571 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8572 call calc_eello(i,jp,i+1,jp1,jj,kk)
8573 if (wcorr4.gt.0.0d0)
8574 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8575 CC & *fac_shield(i)**2*fac_shield(j)**2
8576 if (energy_dec.and.wcorr4.gt.0.0d0)
8577 1 write (iout,'(a6,4i5,0pf7.3)')
8578 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8579 c write (iout,*) "gradcorr5 before eello5"
8581 c write (iout,'(i5,3f10.5)')
8582 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8584 if (wcorr5.gt.0.0d0)
8585 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8586 c write (iout,*) "gradcorr5 after eello5"
8588 c write (iout,'(i5,3f10.5)')
8589 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8591 if (energy_dec.and.wcorr5.gt.0.0d0)
8592 1 write (iout,'(a6,4i5,0pf7.3)')
8593 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8594 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8595 cd write(2,*)'ijkl',i,jp,i+1,jp1
8596 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
8597 & .or. wturn6.eq.0.0d0))then
8598 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8599 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8600 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8601 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8602 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8603 cd & 'ecorr6=',ecorr6
8604 cd write (iout,'(4e15.5)') sred_geom,
8605 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8606 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8607 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8608 else if (wturn6.gt.0.0d0
8609 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8610 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8611 eturn6=eturn6+eello_turn6(i,jj,kk)
8612 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8613 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8614 cd write (2,*) 'multibody_eello:eturn6',eturn6
8623 num_cont_hb(i)=num_cont_hb_old(i)
8625 c write (iout,*) "gradcorr5 in eello5"
8627 c write (iout,'(i5,3f10.5)')
8628 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8632 c------------------------------------------------------------------------------
8633 subroutine add_hb_contact_eello(ii,jj,itask)
8634 implicit real*8 (a-h,o-z)
8635 include "DIMENSIONS"
8636 include "COMMON.IOUNITS"
8639 parameter (max_cont=maxconts)
8640 parameter (max_dim=70)
8641 include "COMMON.CONTACTS"
8642 double precision zapas(max_dim,maxconts,max_fg_procs),
8643 & zapas_recv(max_dim,maxconts,max_fg_procs)
8644 common /przechowalnia/ zapas
8645 integer i,j,ii,jj,iproc,itask(4),nn
8646 c write (iout,*) "itask",itask
8649 if (iproc.gt.0) then
8650 do j=1,num_cont_hb(ii)
8652 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8654 ncont_sent(iproc)=ncont_sent(iproc)+1
8655 nn=ncont_sent(iproc)
8656 zapas(1,nn,iproc)=ii
8657 zapas(2,nn,iproc)=jjc
8658 zapas(3,nn,iproc)=d_cont(j,ii)
8662 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8667 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8675 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8687 c------------------------------------------------------------------------------
8688 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8689 implicit real*8 (a-h,o-z)
8690 include 'DIMENSIONS'
8691 include 'COMMON.IOUNITS'
8692 include 'COMMON.DERIV'
8693 include 'COMMON.INTERACT'
8694 include 'COMMON.CONTACTS'
8695 include 'COMMON.SHIELD'
8696 include 'COMMON.CONTROL'
8697 double precision gx(3),gx1(3)
8700 C print *,"wchodze",fac_shield(i),shield_mode
8708 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8710 C & fac_shield(i)**2*fac_shield(j)**2
8711 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8712 C Following 4 lines for diagnostics.
8717 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8718 c & 'Contacts ',i,j,
8719 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8720 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8722 C Calculate the multi-body contribution to energy.
8723 c ecorr=ecorr+ekont*ees
8724 C Calculate multi-body contributions to the gradient.
8725 coeffpees0pij=coeffp*ees0pij
8726 coeffmees0mij=coeffm*ees0mij
8727 coeffpees0pkl=coeffp*ees0pkl
8728 coeffmees0mkl=coeffm*ees0mkl
8730 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8731 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8732 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8733 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8734 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8735 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8736 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8737 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8738 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8739 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8740 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8741 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8742 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8743 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8744 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8745 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8746 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8747 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8748 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8749 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8750 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8751 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8752 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8753 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8754 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8759 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8760 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8761 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8762 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8767 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8768 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8769 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8770 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8773 c write (iout,*) "ehbcorr",ekont*ees
8774 C print *,ekont,ees,i,k
8776 C now gradient over shielding
8778 if (shield_mode.gt.0) then
8781 C print *,i,j,fac_shield(i),fac_shield(j),
8782 C &fac_shield(k),fac_shield(l)
8783 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
8784 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8785 do ilist=1,ishield_list(i)
8786 iresshield=shield_list(ilist,i)
8788 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8790 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8792 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8793 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8797 do ilist=1,ishield_list(j)
8798 iresshield=shield_list(ilist,j)
8800 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8802 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8804 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8805 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8810 do ilist=1,ishield_list(k)
8811 iresshield=shield_list(ilist,k)
8813 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8815 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8817 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8818 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8822 do ilist=1,ishield_list(l)
8823 iresshield=shield_list(ilist,l)
8825 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8827 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8829 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8830 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8834 C print *,gshieldx(m,iresshield)
8836 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
8837 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8838 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
8839 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8840 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
8841 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8842 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
8843 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8845 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
8846 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8847 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
8848 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8849 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
8850 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8851 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
8852 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8860 C---------------------------------------------------------------------------
8861 subroutine dipole(i,j,jj)
8862 implicit real*8 (a-h,o-z)
8863 include 'DIMENSIONS'
8864 include 'COMMON.IOUNITS'
8865 include 'COMMON.CHAIN'
8866 include 'COMMON.FFIELD'
8867 include 'COMMON.DERIV'
8868 include 'COMMON.INTERACT'
8869 include 'COMMON.CONTACTS'
8870 include 'COMMON.TORSION'
8871 include 'COMMON.VAR'
8872 include 'COMMON.GEO'
8873 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8875 iti1 = itortyp(itype(i+1))
8876 if (j.lt.nres-1) then
8877 itj1 = itype2loc(itype(j+1))
8882 dipi(iii,1)=Ub2(iii,i)
8883 dipderi(iii)=Ub2der(iii,i)
8884 dipi(iii,2)=b1(iii,i+1)
8885 dipj(iii,1)=Ub2(iii,j)
8886 dipderj(iii)=Ub2der(iii,j)
8887 dipj(iii,2)=b1(iii,j+1)
8891 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8894 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8901 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8905 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8910 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8911 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8913 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8915 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8917 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8922 C---------------------------------------------------------------------------
8923 subroutine calc_eello(i,j,k,l,jj,kk)
8925 C This subroutine computes matrices and vectors needed to calculate
8926 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8928 implicit real*8 (a-h,o-z)
8929 include 'DIMENSIONS'
8930 include 'COMMON.IOUNITS'
8931 include 'COMMON.CHAIN'
8932 include 'COMMON.DERIV'
8933 include 'COMMON.INTERACT'
8934 include 'COMMON.CONTACTS'
8935 include 'COMMON.TORSION'
8936 include 'COMMON.VAR'
8937 include 'COMMON.GEO'
8938 include 'COMMON.FFIELD'
8939 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8940 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8943 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8944 cd & ' jj=',jj,' kk=',kk
8945 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8946 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8947 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8950 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8951 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8954 call transpose2(aa1(1,1),aa1t(1,1))
8955 call transpose2(aa2(1,1),aa2t(1,1))
8958 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8959 & aa1tder(1,1,lll,kkk))
8960 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8961 & aa2tder(1,1,lll,kkk))
8965 C parallel orientation of the two CA-CA-CA frames.
8967 iti=itype2loc(itype(i))
8971 itk1=itype2loc(itype(k+1))
8972 itj=itype2loc(itype(j))
8973 if (l.lt.nres-1) then
8974 itl1=itype2loc(itype(l+1))
8978 C A1 kernel(j+1) A2T
8980 cd write (iout,'(3f10.5,5x,3f10.5)')
8981 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8983 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8984 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8985 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8986 C Following matrices are needed only for 6-th order cumulants
8987 IF (wcorr6.gt.0.0d0) THEN
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.,EUgC(1,1,l),EUgCder(1,1,l),
8990 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8991 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8992 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8993 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8994 & ADtEAderx(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.,DtUg2EUg(1,1,l),
8998 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8999 & ADtEA1derx(1,1,1,1,1,1))
9001 C End 6-th order cumulants
9004 cd write (2,*) 'In calc_eello6'
9006 cd write (2,*) 'iii=',iii
9008 cd write (2,*) 'kkk=',kkk
9010 cd write (2,'(3(2f10.5),5x)')
9011 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9016 call transpose2(EUgder(1,1,k),auxmat(1,1))
9017 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9018 call transpose2(EUg(1,1,k),auxmat(1,1))
9019 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9020 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9024 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9025 & EAEAderx(1,1,lll,kkk,iii,1))
9029 C A1T kernel(i+1) A2
9030 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9031 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
9032 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9033 C Following matrices are needed only for 6-th order cumulants
9034 IF (wcorr6.gt.0.0d0) THEN
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.,EUgC(1,1,k),EUgCder(1,1,k),
9037 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9038 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9039 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
9040 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9041 & ADtEAderx(1,1,1,1,1,2))
9042 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9043 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
9044 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9045 & ADtEA1derx(1,1,1,1,1,2))
9047 C End 6-th order cumulants
9048 call transpose2(EUgder(1,1,l),auxmat(1,1))
9049 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
9050 call transpose2(EUg(1,1,l),auxmat(1,1))
9051 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9052 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9056 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9057 & EAEAderx(1,1,lll,kkk,iii,2))
9062 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9063 C They are needed only when the fifth- or the sixth-order cumulants are
9065 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
9066 call transpose2(AEA(1,1,1),auxmat(1,1))
9067 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9068 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9069 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9070 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9071 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9072 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9073 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9074 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9075 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9076 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9077 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9078 call transpose2(AEA(1,1,2),auxmat(1,1))
9079 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
9080 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
9081 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
9082 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9083 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
9084 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
9085 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
9086 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
9087 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
9088 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
9089 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
9090 C Calculate the Cartesian derivatives of the vectors.
9094 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9095 call matvec2(auxmat(1,1),b1(1,i),
9096 & AEAb1derx(1,lll,kkk,iii,1,1))
9097 call matvec2(auxmat(1,1),Ub2(1,i),
9098 & AEAb2derx(1,lll,kkk,iii,1,1))
9099 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9100 & AEAb1derx(1,lll,kkk,iii,2,1))
9101 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9102 & AEAb2derx(1,lll,kkk,iii,2,1))
9103 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9104 call matvec2(auxmat(1,1),b1(1,j),
9105 & AEAb1derx(1,lll,kkk,iii,1,2))
9106 call matvec2(auxmat(1,1),Ub2(1,j),
9107 & AEAb2derx(1,lll,kkk,iii,1,2))
9108 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9109 & AEAb1derx(1,lll,kkk,iii,2,2))
9110 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
9111 & AEAb2derx(1,lll,kkk,iii,2,2))
9118 C Antiparallel orientation of the two CA-CA-CA frames.
9120 iti=itype2loc(itype(i))
9124 itk1=itype2loc(itype(k+1))
9125 itl=itype2loc(itype(l))
9126 itj=itype2loc(itype(j))
9127 if (j.lt.nres-1) then
9128 itj1=itype2loc(itype(j+1))
9132 C A2 kernel(j-1)T A1T
9133 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9134 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
9135 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9136 C Following matrices are needed only for 6-th order cumulants
9137 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9138 & j.eq.i+4 .and. l.eq.i+3)) THEN
9139 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9140 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
9141 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9142 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9143 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
9144 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9145 & ADtEAderx(1,1,1,1,1,1))
9146 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9147 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
9148 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9149 & ADtEA1derx(1,1,1,1,1,1))
9151 C End 6-th order cumulants
9152 call transpose2(EUgder(1,1,k),auxmat(1,1))
9153 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9154 call transpose2(EUg(1,1,k),auxmat(1,1))
9155 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9156 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9160 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9161 & EAEAderx(1,1,lll,kkk,iii,1))
9165 C A2T kernel(i+1)T A1
9166 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9167 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
9168 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9169 C Following matrices are needed only for 6-th order cumulants
9170 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9171 & j.eq.i+4 .and. l.eq.i+3)) THEN
9172 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9173 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
9174 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9175 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9176 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
9177 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9178 & ADtEAderx(1,1,1,1,1,2))
9179 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9180 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
9181 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9182 & ADtEA1derx(1,1,1,1,1,2))
9184 C End 6-th order cumulants
9185 call transpose2(EUgder(1,1,j),auxmat(1,1))
9186 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9187 call transpose2(EUg(1,1,j),auxmat(1,1))
9188 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9189 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9193 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9194 & EAEAderx(1,1,lll,kkk,iii,2))
9199 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9200 C They are needed only when the fifth- or the sixth-order cumulants are
9202 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
9203 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9204 call transpose2(AEA(1,1,1),auxmat(1,1))
9205 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9206 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9207 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9208 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9209 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9210 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9211 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9212 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9213 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9214 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9215 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9216 call transpose2(AEA(1,1,2),auxmat(1,1))
9217 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
9218 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9219 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9220 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9221 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
9222 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9223 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
9224 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
9225 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9226 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9227 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9228 C Calculate the Cartesian derivatives of the vectors.
9232 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9233 call matvec2(auxmat(1,1),b1(1,i),
9234 & AEAb1derx(1,lll,kkk,iii,1,1))
9235 call matvec2(auxmat(1,1),Ub2(1,i),
9236 & AEAb2derx(1,lll,kkk,iii,1,1))
9237 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9238 & AEAb1derx(1,lll,kkk,iii,2,1))
9239 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9240 & AEAb2derx(1,lll,kkk,iii,2,1))
9241 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9242 call matvec2(auxmat(1,1),b1(1,l),
9243 & AEAb1derx(1,lll,kkk,iii,1,2))
9244 call matvec2(auxmat(1,1),Ub2(1,l),
9245 & AEAb2derx(1,lll,kkk,iii,1,2))
9246 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
9247 & AEAb1derx(1,lll,kkk,iii,2,2))
9248 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
9249 & AEAb2derx(1,lll,kkk,iii,2,2))
9258 C---------------------------------------------------------------------------
9259 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
9260 & KK,KKderg,AKA,AKAderg,AKAderx)
9264 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
9265 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
9266 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
9271 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9273 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
9276 cd if (lprn) write (2,*) 'In kernel'
9278 cd if (lprn) write (2,*) 'kkk=',kkk
9280 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
9281 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9283 cd write (2,*) 'lll=',lll
9284 cd write (2,*) 'iii=1'
9286 cd write (2,'(3(2f10.5),5x)')
9287 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9290 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
9291 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9293 cd write (2,*) 'lll=',lll
9294 cd write (2,*) 'iii=2'
9296 cd write (2,'(3(2f10.5),5x)')
9297 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9304 C---------------------------------------------------------------------------
9305 double precision function eello4(i,j,k,l,jj,kk)
9306 implicit real*8 (a-h,o-z)
9307 include 'DIMENSIONS'
9308 include 'COMMON.IOUNITS'
9309 include 'COMMON.CHAIN'
9310 include 'COMMON.DERIV'
9311 include 'COMMON.INTERACT'
9312 include 'COMMON.CONTACTS'
9313 include 'COMMON.TORSION'
9314 include 'COMMON.VAR'
9315 include 'COMMON.GEO'
9316 double precision pizda(2,2),ggg1(3),ggg2(3)
9317 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9321 cd print *,'eello4:',i,j,k,l,jj,kk
9322 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9323 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9324 cold eij=facont_hb(jj,i)
9325 cold ekl=facont_hb(kk,k)
9327 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9328 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9329 gcorr_loc(k-1)=gcorr_loc(k-1)
9330 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9332 gcorr_loc(l-1)=gcorr_loc(l-1)
9333 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9335 gcorr_loc(j-1)=gcorr_loc(j-1)
9336 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9341 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9342 & -EAEAderx(2,2,lll,kkk,iii,1)
9343 cd derx(lll,kkk,iii)=0.0d0
9347 cd gcorr_loc(l-1)=0.0d0
9348 cd gcorr_loc(j-1)=0.0d0
9349 cd gcorr_loc(k-1)=0.0d0
9351 cd write (iout,*)'Contacts have occurred for peptide groups',
9352 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9353 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9354 if (j.lt.nres-1) then
9361 if (l.lt.nres-1) then
9369 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9370 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9371 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9372 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9373 cgrad ghalf=0.5d0*ggg1(ll)
9374 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9375 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9376 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9377 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9378 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9379 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9380 cgrad ghalf=0.5d0*ggg2(ll)
9381 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9382 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9383 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9384 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9385 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9386 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9390 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9395 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9400 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9405 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9409 cd write (2,*) iii,gcorr_loc(iii)
9412 cd write (2,*) 'ekont',ekont
9413 cd write (iout,*) 'eello4',ekont*eel4
9416 C---------------------------------------------------------------------------
9417 double precision function eello5(i,j,k,l,jj,kk)
9418 implicit real*8 (a-h,o-z)
9419 include 'DIMENSIONS'
9420 include 'COMMON.IOUNITS'
9421 include 'COMMON.CHAIN'
9422 include 'COMMON.DERIV'
9423 include 'COMMON.INTERACT'
9424 include 'COMMON.CONTACTS'
9425 include 'COMMON.TORSION'
9426 include 'COMMON.VAR'
9427 include 'COMMON.GEO'
9428 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9429 double precision ggg1(3),ggg2(3)
9430 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9435 C /l\ / \ \ / \ / \ / C
9436 C / \ / \ \ / \ / \ / C
9437 C j| o |l1 | o | o| o | | o |o C
9438 C \ |/k\| |/ \| / |/ \| |/ \| C
9439 C \i/ \ / \ / / \ / \ C
9441 C (I) (II) (III) (IV) C
9443 C eello5_1 eello5_2 eello5_3 eello5_4 C
9445 C Antiparallel chains C
9448 C /j\ / \ \ / \ / \ / C
9449 C / \ / \ \ / \ / \ / C
9450 C j1| o |l | o | o| o | | o |o C
9451 C \ |/k\| |/ \| / |/ \| |/ \| C
9452 C \i/ \ / \ / / \ / \ C
9454 C (I) (II) (III) (IV) C
9456 C eello5_1 eello5_2 eello5_3 eello5_4 C
9458 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9460 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9461 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9466 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9468 itk=itype2loc(itype(k))
9469 itl=itype2loc(itype(l))
9470 itj=itype2loc(itype(j))
9475 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9476 cd & eel5_3_num,eel5_4_num)
9480 derx(lll,kkk,iii)=0.0d0
9484 cd eij=facont_hb(jj,i)
9485 cd ekl=facont_hb(kk,k)
9487 cd write (iout,*)'Contacts have occurred for peptide groups',
9488 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9490 C Contribution from the graph I.
9491 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9492 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9493 call transpose2(EUg(1,1,k),auxmat(1,1))
9494 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9495 vv(1)=pizda(1,1)-pizda(2,2)
9496 vv(2)=pizda(1,2)+pizda(2,1)
9497 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9498 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9499 C Explicit gradient in virtual-dihedral angles.
9500 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9501 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9502 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9503 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9504 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9505 vv(1)=pizda(1,1)-pizda(2,2)
9506 vv(2)=pizda(1,2)+pizda(2,1)
9507 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9508 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9509 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9510 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9511 vv(1)=pizda(1,1)-pizda(2,2)
9512 vv(2)=pizda(1,2)+pizda(2,1)
9514 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9515 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9516 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9518 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9519 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9520 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9522 C Cartesian gradient
9526 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
9528 vv(1)=pizda(1,1)-pizda(2,2)
9529 vv(2)=pizda(1,2)+pizda(2,1)
9530 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9531 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
9532 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9538 C Contribution from graph II
9539 call transpose2(EE(1,1,k),auxmat(1,1))
9540 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9541 vv(1)=pizda(1,1)+pizda(2,2)
9542 vv(2)=pizda(2,1)-pizda(1,2)
9543 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
9544 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9545 C Explicit gradient in virtual-dihedral angles.
9546 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9547 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9548 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9549 vv(1)=pizda(1,1)+pizda(2,2)
9550 vv(2)=pizda(2,1)-pizda(1,2)
9552 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9553 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9554 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9556 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9557 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9558 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9560 C Cartesian gradient
9564 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9566 vv(1)=pizda(1,1)+pizda(2,2)
9567 vv(2)=pizda(2,1)-pizda(1,2)
9568 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9569 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
9570 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9578 C Parallel orientation
9579 C Contribution from graph III
9580 call transpose2(EUg(1,1,l),auxmat(1,1))
9581 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9582 vv(1)=pizda(1,1)-pizda(2,2)
9583 vv(2)=pizda(1,2)+pizda(2,1)
9584 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
9585 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9586 C Explicit gradient in virtual-dihedral angles.
9587 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9588 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
9589 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9590 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9591 vv(1)=pizda(1,1)-pizda(2,2)
9592 vv(2)=pizda(1,2)+pizda(2,1)
9593 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9594 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
9595 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9596 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9597 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9598 vv(1)=pizda(1,1)-pizda(2,2)
9599 vv(2)=pizda(1,2)+pizda(2,1)
9600 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9601 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
9602 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9603 C Cartesian gradient
9607 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9609 vv(1)=pizda(1,1)-pizda(2,2)
9610 vv(2)=pizda(1,2)+pizda(2,1)
9611 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9612 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
9613 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9618 C Contribution from graph IV
9620 call transpose2(EE(1,1,l),auxmat(1,1))
9621 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9622 vv(1)=pizda(1,1)+pizda(2,2)
9623 vv(2)=pizda(2,1)-pizda(1,2)
9624 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
9625 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9626 C Explicit gradient in virtual-dihedral angles.
9627 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9628 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9629 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9630 vv(1)=pizda(1,1)+pizda(2,2)
9631 vv(2)=pizda(2,1)-pizda(1,2)
9632 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9633 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
9634 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9635 C Cartesian gradient
9639 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9641 vv(1)=pizda(1,1)+pizda(2,2)
9642 vv(2)=pizda(2,1)-pizda(1,2)
9643 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9644 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
9645 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9650 C Antiparallel orientation
9651 C Contribution from graph III
9653 call transpose2(EUg(1,1,j),auxmat(1,1))
9654 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9655 vv(1)=pizda(1,1)-pizda(2,2)
9656 vv(2)=pizda(1,2)+pizda(2,1)
9657 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9658 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9659 C Explicit gradient in virtual-dihedral angles.
9660 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9661 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9662 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9663 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9664 vv(1)=pizda(1,1)-pizda(2,2)
9665 vv(2)=pizda(1,2)+pizda(2,1)
9666 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9667 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9668 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9669 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9670 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9671 vv(1)=pizda(1,1)-pizda(2,2)
9672 vv(2)=pizda(1,2)+pizda(2,1)
9673 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9674 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9675 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9676 C Cartesian gradient
9680 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9682 vv(1)=pizda(1,1)-pizda(2,2)
9683 vv(2)=pizda(1,2)+pizda(2,1)
9684 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9685 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9686 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9691 C Contribution from graph IV
9693 call transpose2(EE(1,1,j),auxmat(1,1))
9694 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9695 vv(1)=pizda(1,1)+pizda(2,2)
9696 vv(2)=pizda(2,1)-pizda(1,2)
9697 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9698 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9699 C Explicit gradient in virtual-dihedral angles.
9700 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9701 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9702 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9703 vv(1)=pizda(1,1)+pizda(2,2)
9704 vv(2)=pizda(2,1)-pizda(1,2)
9705 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9706 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9707 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9708 C Cartesian gradient
9712 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9714 vv(1)=pizda(1,1)+pizda(2,2)
9715 vv(2)=pizda(2,1)-pizda(1,2)
9716 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9717 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9718 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9724 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9725 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9726 cd write (2,*) 'ijkl',i,j,k,l
9727 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9728 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9730 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9731 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9732 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9733 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9734 if (j.lt.nres-1) then
9741 if (l.lt.nres-1) then
9751 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9752 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9753 C summed up outside the subrouine as for the other subroutines
9754 C handling long-range interactions. The old code is commented out
9755 C with "cgrad" to keep track of changes.
9757 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9758 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9759 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9760 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9761 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9762 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9763 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9764 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9765 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9766 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9768 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9769 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9770 cgrad ghalf=0.5d0*ggg1(ll)
9772 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9773 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9774 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9775 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9776 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9777 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9778 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9779 cgrad ghalf=0.5d0*ggg2(ll)
9781 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
9782 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9783 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
9784 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9785 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9786 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9791 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9792 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9797 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9798 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9804 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9809 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9813 cd write (2,*) iii,g_corr5_loc(iii)
9816 cd write (2,*) 'ekont',ekont
9817 cd write (iout,*) 'eello5',ekont*eel5
9820 c--------------------------------------------------------------------------
9821 double precision function eello6(i,j,k,l,jj,kk)
9822 implicit real*8 (a-h,o-z)
9823 include 'DIMENSIONS'
9824 include 'COMMON.IOUNITS'
9825 include 'COMMON.CHAIN'
9826 include 'COMMON.DERIV'
9827 include 'COMMON.INTERACT'
9828 include 'COMMON.CONTACTS'
9829 include 'COMMON.TORSION'
9830 include 'COMMON.VAR'
9831 include 'COMMON.GEO'
9832 include 'COMMON.FFIELD'
9833 double precision ggg1(3),ggg2(3)
9834 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9839 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9847 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9848 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9852 derx(lll,kkk,iii)=0.0d0
9856 cd eij=facont_hb(jj,i)
9857 cd ekl=facont_hb(kk,k)
9863 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9864 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9865 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9866 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9867 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9868 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9870 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9871 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9872 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9873 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9874 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9875 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9879 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9881 C If turn contributions are considered, they will be handled separately.
9882 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9883 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9884 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9885 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9886 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9887 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9888 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9890 if (j.lt.nres-1) then
9897 if (l.lt.nres-1) then
9905 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9906 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9907 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9908 cgrad ghalf=0.5d0*ggg1(ll)
9910 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9911 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9912 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9913 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9914 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9915 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9916 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9917 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9918 cgrad ghalf=0.5d0*ggg2(ll)
9919 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9921 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9922 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9923 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9924 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9925 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9926 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9931 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9932 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9937 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9938 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9944 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9949 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9953 cd write (2,*) iii,g_corr6_loc(iii)
9956 cd write (2,*) 'ekont',ekont
9957 cd write (iout,*) 'eello6',ekont*eel6
9960 c--------------------------------------------------------------------------
9961 double precision function eello6_graph1(i,j,k,l,imat,swap)
9962 implicit real*8 (a-h,o-z)
9963 include 'DIMENSIONS'
9964 include 'COMMON.IOUNITS'
9965 include 'COMMON.CHAIN'
9966 include 'COMMON.DERIV'
9967 include 'COMMON.INTERACT'
9968 include 'COMMON.CONTACTS'
9969 include 'COMMON.TORSION'
9970 include 'COMMON.VAR'
9971 include 'COMMON.GEO'
9972 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9976 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9978 C Parallel Antiparallel C
9984 C \ j|/k\| / \ |/k\|l / C
9989 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9990 itk=itype2loc(itype(k))
9991 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9992 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9993 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9994 call transpose2(EUgC(1,1,k),auxmat(1,1))
9995 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9996 vv1(1)=pizda1(1,1)-pizda1(2,2)
9997 vv1(2)=pizda1(1,2)+pizda1(2,1)
9998 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9999 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
10000 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
10001 s5=scalar2(vv(1),Dtobr2(1,i))
10002 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
10003 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
10004 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
10005 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
10006 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
10007 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
10008 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
10009 & +scalar2(vv(1),Dtobr2der(1,i)))
10010 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
10011 vv1(1)=pizda1(1,1)-pizda1(2,2)
10012 vv1(2)=pizda1(1,2)+pizda1(2,1)
10013 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
10014 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
10016 g_corr6_loc(l-1)=g_corr6_loc(l-1)
10017 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
10018 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
10019 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
10020 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10022 g_corr6_loc(j-1)=g_corr6_loc(j-1)
10023 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
10024 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
10025 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
10026 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10028 call transpose2(EUgCder(1,1,k),auxmat(1,1))
10029 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10030 vv1(1)=pizda1(1,1)-pizda1(2,2)
10031 vv1(2)=pizda1(1,2)+pizda1(2,1)
10032 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
10033 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
10034 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
10035 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
10044 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
10045 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
10046 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
10047 call transpose2(EUgC(1,1,k),auxmat(1,1))
10048 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10050 vv1(1)=pizda1(1,1)-pizda1(2,2)
10051 vv1(2)=pizda1(1,2)+pizda1(2,1)
10052 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10053 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
10054 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
10055 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
10056 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
10057 s5=scalar2(vv(1),Dtobr2(1,i))
10058 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
10064 c----------------------------------------------------------------------------
10065 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
10066 implicit real*8 (a-h,o-z)
10067 include 'DIMENSIONS'
10068 include 'COMMON.IOUNITS'
10069 include 'COMMON.CHAIN'
10070 include 'COMMON.DERIV'
10071 include 'COMMON.INTERACT'
10072 include 'COMMON.CONTACTS'
10073 include 'COMMON.TORSION'
10074 include 'COMMON.VAR'
10075 include 'COMMON.GEO'
10077 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10078 & auxvec1(2),auxvec2(2),auxmat1(2,2)
10080 common /kutas/ lprn
10081 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10083 C Parallel Antiparallel C
10089 C \ j|/k\| \ |/k\|l C
10094 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10095 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
10096 C AL 7/4/01 s1 would occur in the sixth-order moment,
10097 C but not in a cluster cumulant
10099 s1=dip(1,jj,i)*dip(1,kk,k)
10101 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
10102 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10103 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
10104 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
10105 call transpose2(EUg(1,1,k),auxmat(1,1))
10106 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
10107 vv(1)=pizda(1,1)-pizda(2,2)
10108 vv(2)=pizda(1,2)+pizda(2,1)
10109 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10110 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10112 eello6_graph2=-(s1+s2+s3+s4)
10114 eello6_graph2=-(s2+s3+s4)
10116 c eello6_graph2=-s3
10117 C Derivatives in gamma(i-1)
10120 s1=dipderg(1,jj,i)*dip(1,kk,k)
10122 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10123 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
10124 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10125 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10127 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10129 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10131 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
10133 C Derivatives in gamma(k-1)
10135 s1=dip(1,jj,i)*dipderg(1,kk,k)
10137 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
10138 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10139 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
10140 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10141 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10142 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
10143 vv(1)=pizda(1,1)-pizda(2,2)
10144 vv(2)=pizda(1,2)+pizda(2,1)
10145 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10147 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10149 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10151 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
10152 C Derivatives in gamma(j-1) or gamma(l-1)
10155 s1=dipderg(3,jj,i)*dip(1,kk,k)
10157 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
10158 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10159 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
10160 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
10161 vv(1)=pizda(1,1)-pizda(2,2)
10162 vv(2)=pizda(1,2)+pizda(2,1)
10163 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10166 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10168 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10171 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10172 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10174 C Derivatives in gamma(l-1) or gamma(j-1)
10177 s1=dip(1,jj,i)*dipderg(3,kk,k)
10179 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10180 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10181 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10182 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10183 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10184 vv(1)=pizda(1,1)-pizda(2,2)
10185 vv(2)=pizda(1,2)+pizda(2,1)
10186 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10189 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10191 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10194 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10195 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10197 C Cartesian derivatives.
10199 write (2,*) 'In eello6_graph2'
10201 write (2,*) 'iii=',iii
10203 write (2,*) 'kkk=',kkk
10205 write (2,'(3(2f10.5),5x)')
10206 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10216 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10218 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10221 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
10223 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10224 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
10226 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10227 call transpose2(EUg(1,1,k),auxmat(1,1))
10228 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
10230 vv(1)=pizda(1,1)-pizda(2,2)
10231 vv(2)=pizda(1,2)+pizda(2,1)
10232 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10233 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10235 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10237 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10240 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10242 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10249 c----------------------------------------------------------------------------
10250 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
10251 implicit real*8 (a-h,o-z)
10252 include 'DIMENSIONS'
10253 include 'COMMON.IOUNITS'
10254 include 'COMMON.CHAIN'
10255 include 'COMMON.DERIV'
10256 include 'COMMON.INTERACT'
10257 include 'COMMON.CONTACTS'
10258 include 'COMMON.TORSION'
10259 include 'COMMON.VAR'
10260 include 'COMMON.GEO'
10261 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
10263 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10265 C Parallel Antiparallel C
10270 C /| o |o o| o |\ C
10271 C j|/k\| / |/k\|l / C
10276 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10278 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10279 C energy moment and not to the cluster cumulant.
10280 iti=itortyp(itype(i))
10281 if (j.lt.nres-1) then
10282 itj1=itype2loc(itype(j+1))
10286 itk=itype2loc(itype(k))
10287 itk1=itype2loc(itype(k+1))
10288 if (l.lt.nres-1) then
10289 itl1=itype2loc(itype(l+1))
10294 s1=dip(4,jj,i)*dip(4,kk,k)
10296 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
10297 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10298 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
10299 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10300 call transpose2(EE(1,1,k),auxmat(1,1))
10301 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10302 vv(1)=pizda(1,1)+pizda(2,2)
10303 vv(2)=pizda(2,1)-pizda(1,2)
10304 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10305 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10306 cd & "sum",-(s2+s3+s4)
10308 eello6_graph3=-(s1+s2+s3+s4)
10310 eello6_graph3=-(s2+s3+s4)
10312 c eello6_graph3=-s4
10313 C Derivatives in gamma(k-1)
10314 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
10315 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10316 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10317 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10318 C Derivatives in gamma(l-1)
10319 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
10320 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10321 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10322 vv(1)=pizda(1,1)+pizda(2,2)
10323 vv(2)=pizda(2,1)-pizda(1,2)
10324 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10325 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10326 C Cartesian derivatives.
10332 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10334 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10337 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
10339 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10340 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
10342 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10343 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
10345 vv(1)=pizda(1,1)+pizda(2,2)
10346 vv(2)=pizda(2,1)-pizda(1,2)
10347 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10349 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10351 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10354 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10356 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10358 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10364 c----------------------------------------------------------------------------
10365 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10366 implicit real*8 (a-h,o-z)
10367 include 'DIMENSIONS'
10368 include 'COMMON.IOUNITS'
10369 include 'COMMON.CHAIN'
10370 include 'COMMON.DERIV'
10371 include 'COMMON.INTERACT'
10372 include 'COMMON.CONTACTS'
10373 include 'COMMON.TORSION'
10374 include 'COMMON.VAR'
10375 include 'COMMON.GEO'
10376 include 'COMMON.FFIELD'
10377 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10378 & auxvec1(2),auxmat1(2,2)
10380 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10382 C Parallel Antiparallel C
10387 C /| o |o o| o |\ C
10388 C \ j|/k\| \ |/k\|l C
10393 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10395 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10396 C energy moment and not to the cluster cumulant.
10397 cd write (2,*) 'eello_graph4: wturn6',wturn6
10398 iti=itype2loc(itype(i))
10399 itj=itype2loc(itype(j))
10400 if (j.lt.nres-1) then
10401 itj1=itype2loc(itype(j+1))
10405 itk=itype2loc(itype(k))
10406 if (k.lt.nres-1) then
10407 itk1=itype2loc(itype(k+1))
10411 itl=itype2loc(itype(l))
10412 if (l.lt.nres-1) then
10413 itl1=itype2loc(itype(l+1))
10417 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10418 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10419 cd & ' itl',itl,' itl1',itl1
10421 if (imat.eq.1) then
10422 s1=dip(3,jj,i)*dip(3,kk,k)
10424 s1=dip(2,jj,j)*dip(2,kk,l)
10427 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10428 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10430 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
10431 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10433 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
10434 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10436 call transpose2(EUg(1,1,k),auxmat(1,1))
10437 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10438 vv(1)=pizda(1,1)-pizda(2,2)
10439 vv(2)=pizda(2,1)+pizda(1,2)
10440 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10441 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10443 eello6_graph4=-(s1+s2+s3+s4)
10445 eello6_graph4=-(s2+s3+s4)
10447 C Derivatives in gamma(i-1)
10450 if (imat.eq.1) then
10451 s1=dipderg(2,jj,i)*dip(3,kk,k)
10453 s1=dipderg(4,jj,j)*dip(2,kk,l)
10456 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10458 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
10459 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10461 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
10462 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10464 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10465 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10466 cd write (2,*) 'turn6 derivatives'
10468 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10470 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10474 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10476 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10480 C Derivatives in gamma(k-1)
10482 if (imat.eq.1) then
10483 s1=dip(3,jj,i)*dipderg(2,kk,k)
10485 s1=dip(2,jj,j)*dipderg(4,kk,l)
10488 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10489 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10491 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
10492 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10494 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
10495 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10497 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10498 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10499 vv(1)=pizda(1,1)-pizda(2,2)
10500 vv(2)=pizda(2,1)+pizda(1,2)
10501 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10502 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10504 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10506 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10510 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10512 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10515 C Derivatives in gamma(j-1) or gamma(l-1)
10516 if (l.eq.j+1 .and. l.gt.1) then
10517 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10518 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10519 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10520 vv(1)=pizda(1,1)-pizda(2,2)
10521 vv(2)=pizda(2,1)+pizda(1,2)
10522 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10523 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10524 else if (j.gt.1) then
10525 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10526 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10527 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10528 vv(1)=pizda(1,1)-pizda(2,2)
10529 vv(2)=pizda(2,1)+pizda(1,2)
10530 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10531 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10532 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10534 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10537 C Cartesian derivatives.
10543 if (imat.eq.1) then
10544 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10546 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10549 if (imat.eq.1) then
10550 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10552 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10556 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
10558 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10560 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10561 & b1(1,j+1),auxvec(1))
10562 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
10564 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10565 & b1(1,l+1),auxvec(1))
10566 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
10568 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10570 vv(1)=pizda(1,1)-pizda(2,2)
10571 vv(2)=pizda(2,1)+pizda(1,2)
10572 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10574 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10576 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10579 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10582 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10585 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10587 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10589 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10593 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10595 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10598 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10600 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10608 c----------------------------------------------------------------------------
10609 double precision function eello_turn6(i,jj,kk)
10610 implicit real*8 (a-h,o-z)
10611 include 'DIMENSIONS'
10612 include 'COMMON.IOUNITS'
10613 include 'COMMON.CHAIN'
10614 include 'COMMON.DERIV'
10615 include 'COMMON.INTERACT'
10616 include 'COMMON.CONTACTS'
10617 include 'COMMON.TORSION'
10618 include 'COMMON.VAR'
10619 include 'COMMON.GEO'
10620 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
10621 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
10623 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
10624 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
10625 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10626 C the respective energy moment and not to the cluster cumulant.
10635 iti=itype2loc(itype(i))
10636 itk=itype2loc(itype(k))
10637 itk1=itype2loc(itype(k+1))
10638 itl=itype2loc(itype(l))
10639 itj=itype2loc(itype(j))
10640 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10641 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
10642 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10647 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10649 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10653 derx_turn(lll,kkk,iii)=0.0d0
10660 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10662 cd write (2,*) 'eello6_5',eello6_5
10664 call transpose2(AEA(1,1,1),auxmat(1,1))
10665 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10666 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10667 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10669 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10670 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10671 s2 = scalar2(b1(1,k),vtemp1(1))
10673 call transpose2(AEA(1,1,2),atemp(1,1))
10674 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10675 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10676 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10678 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10679 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10680 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10682 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10683 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10684 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10685 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10686 ss13 = scalar2(b1(1,k),vtemp4(1))
10687 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10689 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10695 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10696 C Derivatives in gamma(i+2)
10700 call transpose2(AEA(1,1,1),auxmatd(1,1))
10701 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10702 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10703 call transpose2(AEAderg(1,1,2),atempd(1,1))
10704 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10705 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10707 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10708 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10709 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10715 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10716 C Derivatives in gamma(i+3)
10718 call transpose2(AEA(1,1,1),auxmatd(1,1))
10719 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10720 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10721 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10723 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10724 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10725 s2d = scalar2(b1(1,k),vtemp1d(1))
10727 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10728 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10730 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10732 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10733 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10734 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10742 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10743 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10745 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10746 & -0.5d0*ekont*(s2d+s12d)
10748 C Derivatives in gamma(i+4)
10749 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10750 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10751 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10753 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10754 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10755 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10763 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10765 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10767 C Derivatives in gamma(i+5)
10769 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10770 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10771 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10773 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10774 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10775 s2d = scalar2(b1(1,k),vtemp1d(1))
10777 call transpose2(AEA(1,1,2),atempd(1,1))
10778 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10779 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10781 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10782 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10784 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10785 ss13d = scalar2(b1(1,k),vtemp4d(1))
10786 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10794 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10795 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10797 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10798 & -0.5d0*ekont*(s2d+s12d)
10800 C Cartesian derivatives
10805 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10806 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10807 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10809 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10810 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10812 s2d = scalar2(b1(1,k),vtemp1d(1))
10814 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10815 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10816 s8d = -(atempd(1,1)+atempd(2,2))*
10817 & scalar2(cc(1,1,itl),vtemp2(1))
10819 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10821 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10822 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10829 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10830 & - 0.5d0*(s1d+s2d)
10832 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10836 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10837 & - 0.5d0*(s8d+s12d)
10839 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10848 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10849 & achuj_tempd(1,1))
10850 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10851 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10852 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10853 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10854 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10856 ss13d = scalar2(b1(1,k),vtemp4d(1))
10857 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10858 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10862 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10863 cd & 16*eel_turn6_num
10865 if (j.lt.nres-1) then
10872 if (l.lt.nres-1) then
10880 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10881 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10882 cgrad ghalf=0.5d0*ggg1(ll)
10884 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10885 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10886 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10887 & +ekont*derx_turn(ll,2,1)
10888 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10889 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10890 & +ekont*derx_turn(ll,4,1)
10891 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10892 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10893 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10894 cgrad ghalf=0.5d0*ggg2(ll)
10896 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10897 & +ekont*derx_turn(ll,2,2)
10898 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10899 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10900 & +ekont*derx_turn(ll,4,2)
10901 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10902 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10903 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10908 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10913 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10919 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10924 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10928 cd write (2,*) iii,g_corr6_loc(iii)
10930 eello_turn6=ekont*eel_turn6
10931 cd write (2,*) 'ekont',ekont
10932 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10936 C-----------------------------------------------------------------------------
10937 double precision function scalar(u,v)
10938 !DIR$ INLINEALWAYS scalar
10940 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10943 double precision u(3),v(3)
10944 cd double precision sc
10952 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10955 crc-------------------------------------------------
10956 SUBROUTINE MATVEC2(A1,V1,V2)
10957 !DIR$ INLINEALWAYS MATVEC2
10959 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10961 implicit real*8 (a-h,o-z)
10962 include 'DIMENSIONS'
10963 DIMENSION A1(2,2),V1(2),V2(2)
10967 c 3 VI=VI+A1(I,K)*V1(K)
10971 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10972 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10977 C---------------------------------------
10978 SUBROUTINE MATMAT2(A1,A2,A3)
10980 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10982 implicit real*8 (a-h,o-z)
10983 include 'DIMENSIONS'
10984 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10985 c DIMENSION AI3(2,2)
10989 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10995 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10996 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10997 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10998 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
11006 c-------------------------------------------------------------------------
11007 double precision function scalar2(u,v)
11008 !DIR$ INLINEALWAYS scalar2
11010 double precision u(2),v(2)
11011 double precision sc
11013 scalar2=u(1)*v(1)+u(2)*v(2)
11017 C-----------------------------------------------------------------------------
11019 subroutine transpose2(a,at)
11020 !DIR$ INLINEALWAYS transpose2
11022 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
11025 double precision a(2,2),at(2,2)
11032 c--------------------------------------------------------------------------
11033 subroutine transpose(n,a,at)
11036 double precision a(n,n),at(n,n)
11044 C---------------------------------------------------------------------------
11045 subroutine prodmat3(a1,a2,kk,transp,prod)
11046 !DIR$ INLINEALWAYS prodmat3
11048 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
11052 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
11054 crc double precision auxmat(2,2),prod_(2,2)
11057 crc call transpose2(kk(1,1),auxmat(1,1))
11058 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
11059 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11061 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
11062 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
11063 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
11064 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
11065 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
11066 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
11067 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
11068 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
11071 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
11072 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11074 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
11075 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
11076 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
11077 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
11078 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
11079 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
11080 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
11081 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
11084 c call transpose2(a2(1,1),a2t(1,1))
11087 crc print *,((prod_(i,j),i=1,2),j=1,2)
11088 crc print *,((prod(i,j),i=1,2),j=1,2)
11092 CCC----------------------------------------------
11093 subroutine Eliptransfer(eliptran)
11094 implicit real*8 (a-h,o-z)
11095 include 'DIMENSIONS'
11096 include 'COMMON.GEO'
11097 include 'COMMON.VAR'
11098 include 'COMMON.LOCAL'
11099 include 'COMMON.CHAIN'
11100 include 'COMMON.DERIV'
11101 include 'COMMON.NAMES'
11102 include 'COMMON.INTERACT'
11103 include 'COMMON.IOUNITS'
11104 include 'COMMON.CALC'
11105 include 'COMMON.CONTROL'
11106 include 'COMMON.SPLITELE'
11107 include 'COMMON.SBRIDGE'
11108 C this is done by Adasko
11109 C print *,"wchodze"
11110 C structure of box:
11112 C--bordliptop-- buffore starts
11113 C--bufliptop--- here true lipid starts
11115 C--buflipbot--- lipid ends buffore starts
11116 C--bordlipbot--buffore ends
11118 do i=ilip_start,ilip_end
11120 if (itype(i).eq.ntyp1) cycle
11122 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
11123 if (positi.le.0) positi=positi+boxzsize
11125 C first for peptide groups
11126 c for each residue check if it is in lipid or lipid water border area
11127 if ((positi.gt.bordlipbot)
11128 &.and.(positi.lt.bordliptop)) then
11129 C the energy transfer exist
11130 if (positi.lt.buflipbot) then
11131 C what fraction I am in
11133 & ((positi-bordlipbot)/lipbufthick)
11134 C lipbufthick is thickenes of lipid buffore
11135 sslip=sscalelip(fracinbuf)
11136 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11137 eliptran=eliptran+sslip*pepliptran
11138 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11139 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11140 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11142 C print *,"doing sccale for lower part"
11143 C print *,i,sslip,fracinbuf,ssgradlip
11144 elseif (positi.gt.bufliptop) then
11145 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
11146 sslip=sscalelip(fracinbuf)
11147 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11148 eliptran=eliptran+sslip*pepliptran
11149 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11150 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11151 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11152 C print *, "doing sscalefor top part"
11153 C print *,i,sslip,fracinbuf,ssgradlip
11155 eliptran=eliptran+pepliptran
11156 C print *,"I am in true lipid"
11159 C eliptran=elpitran+0.0 ! I am in water
11162 C print *, "nic nie bylo w lipidzie?"
11163 C now multiply all by the peptide group transfer factor
11164 C eliptran=eliptran*pepliptran
11165 C now the same for side chains
11167 do i=ilip_start,ilip_end
11168 if (itype(i).eq.ntyp1) cycle
11169 positi=(mod(c(3,i+nres),boxzsize))
11170 if (positi.le.0) positi=positi+boxzsize
11171 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
11172 c for each residue check if it is in lipid or lipid water border area
11173 C respos=mod(c(3,i+nres),boxzsize)
11174 C print *,positi,bordlipbot,buflipbot
11175 if ((positi.gt.bordlipbot)
11176 & .and.(positi.lt.bordliptop)) then
11177 C the energy transfer exist
11178 if (positi.lt.buflipbot) then
11180 & ((positi-bordlipbot)/lipbufthick)
11181 C lipbufthick is thickenes of lipid buffore
11182 sslip=sscalelip(fracinbuf)
11183 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11184 eliptran=eliptran+sslip*liptranene(itype(i))
11185 gliptranx(3,i)=gliptranx(3,i)
11186 &+ssgradlip*liptranene(itype(i))
11187 gliptranc(3,i-1)= gliptranc(3,i-1)
11188 &+ssgradlip*liptranene(itype(i))
11189 C print *,"doing sccale for lower part"
11190 elseif (positi.gt.bufliptop) then
11192 &((bordliptop-positi)/lipbufthick)
11193 sslip=sscalelip(fracinbuf)
11194 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11195 eliptran=eliptran+sslip*liptranene(itype(i))
11196 gliptranx(3,i)=gliptranx(3,i)
11197 &+ssgradlip*liptranene(itype(i))
11198 gliptranc(3,i-1)= gliptranc(3,i-1)
11199 &+ssgradlip*liptranene(itype(i))
11200 C print *, "doing sscalefor top part",sslip,fracinbuf
11202 eliptran=eliptran+liptranene(itype(i))
11203 C print *,"I am in true lipid"
11205 endif ! if in lipid or buffor
11207 C eliptran=elpitran+0.0 ! I am in water
11211 C---------------------------------------------------------
11212 C AFM soubroutine for constant force
11213 subroutine AFMforce(Eafmforce)
11214 implicit real*8 (a-h,o-z)
11215 include 'DIMENSIONS'
11216 include 'COMMON.GEO'
11217 include 'COMMON.VAR'
11218 include 'COMMON.LOCAL'
11219 include 'COMMON.CHAIN'
11220 include 'COMMON.DERIV'
11221 include 'COMMON.NAMES'
11222 include 'COMMON.INTERACT'
11223 include 'COMMON.IOUNITS'
11224 include 'COMMON.CALC'
11225 include 'COMMON.CONTROL'
11226 include 'COMMON.SPLITELE'
11227 include 'COMMON.SBRIDGE'
11232 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11233 dist=dist+diffafm(i)**2
11236 Eafmforce=-forceAFMconst*(dist-distafminit)
11238 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
11239 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
11241 C print *,'AFM',Eafmforce
11244 C---------------------------------------------------------
11245 C AFM subroutine with pseudoconstant velocity
11246 subroutine AFMvel(Eafmforce)
11247 implicit real*8 (a-h,o-z)
11248 include 'DIMENSIONS'
11249 include 'COMMON.GEO'
11250 include 'COMMON.VAR'
11251 include 'COMMON.LOCAL'
11252 include 'COMMON.CHAIN'
11253 include 'COMMON.DERIV'
11254 include 'COMMON.NAMES'
11255 include 'COMMON.INTERACT'
11256 include 'COMMON.IOUNITS'
11257 include 'COMMON.CALC'
11258 include 'COMMON.CONTROL'
11259 include 'COMMON.SPLITELE'
11260 include 'COMMON.SBRIDGE'
11262 C Only for check grad COMMENT if not used for checkgrad
11264 C--------------------------------------------------------
11265 C print *,"wchodze"
11269 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11270 dist=dist+diffafm(i)**2
11273 Eafmforce=0.5d0*forceAFMconst
11274 & *(distafminit+totTafm*velAFMconst-dist)**2
11275 C Eafmforce=-forceAFMconst*(dist-distafminit)
11277 gradafm(i,afmend-1)=-forceAFMconst*
11278 &(distafminit+totTafm*velAFMconst-dist)
11280 gradafm(i,afmbeg-1)=forceAFMconst*
11281 &(distafminit+totTafm*velAFMconst-dist)
11284 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
11287 C-----------------------------------------------------------
11288 C first for shielding is setting of function of side-chains
11289 subroutine set_shield_fac
11290 implicit real*8 (a-h,o-z)
11291 include 'DIMENSIONS'
11292 include 'COMMON.CHAIN'
11293 include 'COMMON.DERIV'
11294 include 'COMMON.IOUNITS'
11295 include 'COMMON.SHIELD'
11296 include 'COMMON.INTERACT'
11297 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11298 double precision div77_81/0.974996043d0/,
11299 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11301 C the vector between center of side_chain and peptide group
11302 double precision pep_side(3),long,side_calf(3),
11303 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11304 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11305 C the line belowe needs to be changed for FGPROC>1
11307 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11309 Cif there two consequtive dummy atoms there is no peptide group between them
11310 C the line below has to be changed for FGPROC>1
11313 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11317 C first lets set vector conecting the ithe side-chain with kth side-chain
11318 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11319 C pep_side(j)=2.0d0
11320 C and vector conecting the side-chain with its proper calfa
11321 side_calf(j)=c(j,k+nres)-c(j,k)
11322 C side_calf(j)=2.0d0
11323 pept_group(j)=c(j,i)-c(j,i+1)
11324 C lets have their lenght
11325 dist_pep_side=pep_side(j)**2+dist_pep_side
11326 dist_side_calf=dist_side_calf+side_calf(j)**2
11327 dist_pept_group=dist_pept_group+pept_group(j)**2
11329 dist_pep_side=dsqrt(dist_pep_side)
11330 dist_pept_group=dsqrt(dist_pept_group)
11331 dist_side_calf=dsqrt(dist_side_calf)
11333 pep_side_norm(j)=pep_side(j)/dist_pep_side
11334 side_calf_norm(j)=dist_side_calf
11336 C now sscale fraction
11337 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
11338 C print *,buff_shield,"buff"
11340 if (sh_frac_dist.le.0.0) cycle
11341 C If we reach here it means that this side chain reaches the shielding sphere
11342 C Lets add him to the list for gradient
11343 ishield_list(i)=ishield_list(i)+1
11344 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
11345 C this list is essential otherwise problem would be O3
11346 shield_list(ishield_list(i),i)=k
11347 C Lets have the sscale value
11348 if (sh_frac_dist.gt.1.0) then
11349 scale_fac_dist=1.0d0
11351 sh_frac_dist_grad(j)=0.0d0
11354 scale_fac_dist=-sh_frac_dist*sh_frac_dist
11355 & *(2.0*sh_frac_dist-3.0d0)
11356 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
11357 & /dist_pep_side/buff_shield*0.5
11358 C remember for the final gradient multiply sh_frac_dist_grad(j)
11359 C for side_chain by factor -2 !
11361 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
11362 C print *,"jestem",scale_fac_dist,fac_help_scale,
11363 C & sh_frac_dist_grad(j)
11366 C if ((i.eq.3).and.(k.eq.2)) then
11367 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
11371 C this is what is now we have the distance scaling now volume...
11372 short=short_r_sidechain(itype(k))
11373 long=long_r_sidechain(itype(k))
11374 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
11377 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
11378 C costhet_fac=0.0d0
11380 costhet_grad(j)=costhet_fac*pep_side(j)
11382 C remember for the final gradient multiply costhet_grad(j)
11383 C for side_chain by factor -2 !
11384 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
11385 C pep_side0pept_group is vector multiplication
11386 pep_side0pept_group=0.0
11388 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
11390 cosalfa=(pep_side0pept_group/
11391 & (dist_pep_side*dist_side_calf))
11392 fac_alfa_sin=1.0-cosalfa**2
11393 fac_alfa_sin=dsqrt(fac_alfa_sin)
11394 rkprim=fac_alfa_sin*(long-short)+short
11396 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
11397 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
11400 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
11401 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11402 &*(long-short)/fac_alfa_sin*cosalfa/
11403 &((dist_pep_side*dist_side_calf))*
11404 &((side_calf(j))-cosalfa*
11405 &((pep_side(j)/dist_pep_side)*dist_side_calf))
11407 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11408 &*(long-short)/fac_alfa_sin*cosalfa
11409 &/((dist_pep_side*dist_side_calf))*
11411 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
11414 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
11417 C now the gradient...
11418 C grad_shield is gradient of Calfa for peptide groups
11419 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
11421 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
11422 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
11424 grad_shield(j,i)=grad_shield(j,i)
11425 C gradient po skalowaniu
11426 & +(sh_frac_dist_grad(j)
11427 C gradient po costhet
11428 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
11429 &-scale_fac_dist*(cosphi_grad_long(j))
11430 &/(1.0-cosphi) )*div77_81
11432 C grad_shield_side is Cbeta sidechain gradient
11433 grad_shield_side(j,ishield_list(i),i)=
11434 & (sh_frac_dist_grad(j)*-2.0d0
11435 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
11436 & +scale_fac_dist*(cosphi_grad_long(j))
11437 & *2.0d0/(1.0-cosphi))
11438 & *div77_81*VofOverlap
11440 grad_shield_loc(j,ishield_list(i),i)=
11441 & scale_fac_dist*cosphi_grad_loc(j)
11442 & *2.0d0/(1.0-cosphi)
11443 & *div77_81*VofOverlap
11445 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
11447 fac_shield(i)=VolumeTotal*div77_81+div4_81
11448 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
11452 C--------------------------------------------------------------------------
11453 double precision function tschebyshev(m,n,x,y)
11455 include "DIMENSIONS"
11457 double precision x(n),y,yy(0:maxvar),aux
11458 c Tschebyshev polynomial. Note that the first term is omitted
11459 c m=0: the constant term is included
11460 c m=1: the constant term is not included
11464 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
11473 C--------------------------------------------------------------------------
11474 double precision function gradtschebyshev(m,n,x,y)
11476 include "DIMENSIONS"
11478 double precision x(n+1),y,yy(0:maxvar),aux
11479 c Tschebyshev polynomial. Note that the first term is omitted
11480 c m=0: the constant term is included
11481 c m=1: the constant term is not included
11485 yy(i)=2*y*yy(i-1)-yy(i-2)
11489 aux=aux+x(i+1)*yy(i)*(i+1)
11490 C print *, x(i+1),yy(i),i
11492 gradtschebyshev=aux
11495 C------------------------------------------------------------------------
11496 C first for shielding is setting of function of side-chains
11497 subroutine set_shield_fac2
11498 implicit real*8 (a-h,o-z)
11499 include 'DIMENSIONS'
11500 include 'COMMON.CHAIN'
11501 include 'COMMON.DERIV'
11502 include 'COMMON.IOUNITS'
11503 include 'COMMON.SHIELD'
11504 include 'COMMON.INTERACT'
11505 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11506 double precision div77_81/0.974996043d0/,
11507 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11509 C the vector between center of side_chain and peptide group
11510 double precision pep_side(3),long,side_calf(3),
11511 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11512 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11513 C the line belowe needs to be changed for FGPROC>1
11515 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11517 Cif there two consequtive dummy atoms there is no peptide group between them
11518 C the line below has to be changed for FGPROC>1
11521 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11525 C first lets set vector conecting the ithe side-chain with kth side-chain
11526 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11527 C pep_side(j)=2.0d0
11528 C and vector conecting the side-chain with its proper calfa
11529 side_calf(j)=c(j,k+nres)-c(j,k)
11530 C side_calf(j)=2.0d0
11531 pept_group(j)=c(j,i)-c(j,i+1)
11532 C lets have their lenght
11533 dist_pep_side=pep_side(j)**2+dist_pep_side
11534 dist_side_calf=dist_side_calf+side_calf(j)**2
11535 dist_pept_group=dist_pept_group+pept_group(j)**2
11537 dist_pep_side=dsqrt(dist_pep_side)
11538 dist_pept_group=dsqrt(dist_pept_group)
11539 dist_side_calf=dsqrt(dist_side_calf)
11541 pep_side_norm(j)=pep_side(j)/dist_pep_side
11542 side_calf_norm(j)=dist_side_calf
11544 C now sscale fraction
11545 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
11546 C print *,buff_shield,"buff"
11548 if (sh_frac_dist.le.0.0) cycle
11549 C If we reach here it means that this side chain reaches the shielding sphere
11550 C Lets add him to the list for gradient
11551 ishield_list(i)=ishield_list(i)+1
11552 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
11553 C this list is essential otherwise problem would be O3
11554 shield_list(ishield_list(i),i)=k
11555 C Lets have the sscale value
11556 if (sh_frac_dist.gt.1.0) then
11557 scale_fac_dist=1.0d0
11559 sh_frac_dist_grad(j)=0.0d0
11562 scale_fac_dist=-sh_frac_dist*sh_frac_dist
11563 & *(2.0d0*sh_frac_dist-3.0d0)
11564 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
11565 & /dist_pep_side/buff_shield*0.5d0
11566 C remember for the final gradient multiply sh_frac_dist_grad(j)
11567 C for side_chain by factor -2 !
11569 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
11570 C sh_frac_dist_grad(j)=0.0d0
11571 C scale_fac_dist=1.0d0
11572 C print *,"jestem",scale_fac_dist,fac_help_scale,
11573 C & sh_frac_dist_grad(j)
11576 C this is what is now we have the distance scaling now volume...
11577 short=short_r_sidechain(itype(k))
11578 long=long_r_sidechain(itype(k))
11579 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
11580 sinthet=short/dist_pep_side*costhet
11584 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
11585 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
11586 C & -short/dist_pep_side**2/costhet)
11587 C costhet_fac=0.0d0
11589 costhet_grad(j)=costhet_fac*pep_side(j)
11591 C remember for the final gradient multiply costhet_grad(j)
11592 C for side_chain by factor -2 !
11593 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
11594 C pep_side0pept_group is vector multiplication
11595 pep_side0pept_group=0.0d0
11597 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
11599 cosalfa=(pep_side0pept_group/
11600 & (dist_pep_side*dist_side_calf))
11601 fac_alfa_sin=1.0d0-cosalfa**2
11602 fac_alfa_sin=dsqrt(fac_alfa_sin)
11603 rkprim=fac_alfa_sin*(long-short)+short
11607 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
11609 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
11610 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
11611 & dist_pep_side**2)
11614 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
11615 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
11616 &*(long-short)/fac_alfa_sin*cosalfa/
11617 &((dist_pep_side*dist_side_calf))*
11618 &((side_calf(j))-cosalfa*
11619 &((pep_side(j)/dist_pep_side)*dist_side_calf))
11620 C cosphi_grad_long(j)=0.0d0
11621 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
11622 &*(long-short)/fac_alfa_sin*cosalfa
11623 &/((dist_pep_side*dist_side_calf))*
11625 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
11626 C cosphi_grad_loc(j)=0.0d0
11628 C print *,sinphi,sinthet
11629 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
11632 C now the gradient...
11634 grad_shield(j,i)=grad_shield(j,i)
11635 C gradient po skalowaniu
11636 & +(sh_frac_dist_grad(j)*VofOverlap
11637 C gradient po costhet
11638 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
11639 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
11640 & sinphi/sinthet*costhet*costhet_grad(j)
11641 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
11643 C grad_shield_side is Cbeta sidechain gradient
11644 grad_shield_side(j,ishield_list(i),i)=
11645 & (sh_frac_dist_grad(j)*-2.0d0
11647 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
11648 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
11649 & sinphi/sinthet*costhet*costhet_grad(j)
11650 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
11653 grad_shield_loc(j,ishield_list(i),i)=
11654 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
11655 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
11656 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
11660 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
11662 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
11663 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)