1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
27 include 'COMMON.SPLITELE'
29 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
30 c & " nfgtasks",nfgtasks
31 if (nfgtasks.gt.1) then
33 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
34 if (fg_rank.eq.0) then
35 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
36 c print *,"Processor",myrank," BROADCAST iorder"
37 C FG master sets up the WEIGHTS_ array which will be broadcast to the
38 C FG slaves as WEIGHTS array.
60 C FG Master broadcasts the WEIGHTS_ array
61 call MPI_Bcast(weights_(1),n_ene,
62 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
64 C FG slaves receive the WEIGHTS array
65 call MPI_Bcast(weights(1),n_ene,
66 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
88 time_Bcast=time_Bcast+MPI_Wtime()-time00
89 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
90 c call chainbuild_cart
92 c print *,'Processor',myrank,' calling etotal ipot=',ipot
93 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
95 c if (modecalc.eq.12.or.modecalc.eq.14) then
96 c call int_from_cart1(.false.)
103 C Compute the side-chain and electrostatic interaction energy
106 goto (101,102,103,104,105,106) ipot
107 C Lennard-Jones potential.
109 cd print '(a)','Exit ELJ'
111 C Lennard-Jones-Kihara potential (shifted).
114 C Berne-Pechukas potential (dilated LJ, angular dependence).
117 C Gay-Berne potential (shifted LJ, angular dependence).
119 C print *,"bylem w egb"
121 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
124 C Soft-sphere potential
125 106 call e_softsphere(evdw)
127 C Calculate electrostatic (H-bonding) energy of the main chain.
131 cmc Sep-06: egb takes care of dynamic ss bonds too
133 c if (dyn_ss) call dyn_set_nss
135 c print *,"Processor",myrank," computed USCSC"
141 time_vec=time_vec+MPI_Wtime()-time01
143 C Introduction of shielding effect first for each peptide group
144 C the shielding factor is set this factor is describing how each
145 C peptide group is shielded by side-chains
146 C the matrix - shield_fac(i) the i index describe the ith between i and i+1
147 C write (iout,*) "shield_mode",shield_mode
148 if (shield_mode.eq.1) then
150 else if (shield_mode.eq.2) then
153 c print *,"Processor",myrank," left VEC_AND_DERIV"
156 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
157 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
158 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
159 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
161 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
162 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
163 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
164 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
166 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
175 write (iout,*) "Soft-spheer ELEC potential"
176 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
179 c print *,"Processor",myrank," computed UELEC"
181 C Calculate excluded-volume interaction energy between peptide groups
186 call escp(evdw2,evdw2_14)
192 c write (iout,*) "Soft-sphere SCP potential"
193 call escp_soft_sphere(evdw2,evdw2_14)
196 c Calculate the bond-stretching energy
200 C Calculate the disulfide-bridge and other energy and the contributions
201 C from other distance constraints.
202 cd print *,'Calling EHPB'
204 cd print *,'EHPB exitted succesfully.'
206 C Calculate the virtual-bond-angle energy.
208 if (wang.gt.0d0) then
209 if ((tor_mode.eq.0).or.(tor_mode.eq.2)) then
210 call ebend(ebe,ethetacnstr)
212 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
214 if ((tor_mode.eq.1).or.(tor_mode.eq.2)) then
215 call ebend_kcc(ebe,ethetacnstr)
221 c print *,"Processor",myrank," computed UB"
223 C Calculate the SC local energy.
225 C print *,"TU DOCHODZE?"
227 c print *,"Processor",myrank," computed USC"
229 C Calculate the virtual-bond torsional energy.
231 cd print *,'nterm=',nterm
232 C print *,"tor",tor_mode
234 if ((tor_mode.eq.0).or.(tor_mode.eq.2)) then
235 call etor(etors,edihcnstr)
237 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
239 if ((tor_mode.eq.1).or.(tor_mode.eq.2)) then
240 call etor_kcc(etors,edihcnstr)
246 c print *,"Processor",myrank," computed Utor"
248 C 6/23/01 Calculate double-torsional energy
250 if ((wtor_d.gt.0).and.((tor_mode.eq.0).or.(tor_mode.eq.2))) then
255 c print *,"Processor",myrank," computed Utord"
257 C 21/5/07 Calculate local sicdechain correlation energy
259 if (wsccor.gt.0.0d0) then
260 call eback_sc_corr(esccor)
264 C print *,"PRZED MULIt"
265 c print *,"Processor",myrank," computed Usccorr"
267 C 12/1/95 Multi-body terms
271 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
272 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
273 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
274 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
275 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
282 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
283 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
284 cd write (iout,*) "multibody_hb ecorr",ecorr
286 c print *,"Processor",myrank," computed Ucorr"
288 C If performing constraint dynamics, call the constraint energy
289 C after the equilibration time
290 if(usampl.and.totT.gt.eq_time) then
297 C 01/27/2015 added by adasko
298 C the energy component below is energy transfer into lipid environment
299 C based on partition function
300 C print *,"przed lipidami"
301 if (wliptran.gt.0) then
302 call Eliptransfer(eliptran)
304 C print *,"za lipidami"
305 if (AFMlog.gt.0) then
306 call AFMforce(Eafmforce)
307 else if (selfguide.gt.0) then
308 call AFMvel(Eafmforce)
310 if (TUBElog.eq.1) then
311 C print *,"just before call"
313 elseif (TUBElog.eq.2) then
314 call calctube2(Etube)
320 time_enecalc=time_enecalc+MPI_Wtime()-time00
322 c print *,"Processor",myrank," computed Uconstr"
331 energia(2)=evdw2-evdw2_14
348 energia(8)=eello_turn3
349 energia(9)=eello_turn4
356 energia(19)=edihcnstr
358 energia(20)=Uconst+Uconst_back
361 energia(23)=Eafmforce
362 energia(24)=ethetacnstr
364 c Here are the energies showed per procesor if the are more processors
365 c per molecule then we sum it up in sum_energy subroutine
366 c print *," Processor",myrank," calls SUM_ENERGY"
367 call sum_energy(energia,.true.)
368 if (dyn_ss) call dyn_set_nss
369 c print *," Processor",myrank," left SUM_ENERGY"
371 time_sumene=time_sumene+MPI_Wtime()-time00
375 c-------------------------------------------------------------------------------
376 subroutine sum_energy(energia,reduce)
377 implicit real*8 (a-h,o-z)
382 cMS$ATTRIBUTES C :: proc_proc
388 include 'COMMON.SETUP'
389 include 'COMMON.IOUNITS'
390 double precision energia(0:n_ene),enebuff(0:n_ene+1)
391 include 'COMMON.FFIELD'
392 include 'COMMON.DERIV'
393 include 'COMMON.INTERACT'
394 include 'COMMON.SBRIDGE'
395 include 'COMMON.CHAIN'
397 include 'COMMON.CONTROL'
398 include 'COMMON.TIME1'
401 if (nfgtasks.gt.1 .and. reduce) then
403 write (iout,*) "energies before REDUCE"
404 call enerprint(energia)
408 enebuff(i)=energia(i)
411 call MPI_Barrier(FG_COMM,IERR)
412 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
414 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
415 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
417 write (iout,*) "energies after REDUCE"
418 call enerprint(energia)
421 time_Reduce=time_Reduce+MPI_Wtime()-time00
423 if (fg_rank.eq.0) then
427 evdw2=energia(2)+energia(18)
443 eello_turn3=energia(8)
444 eello_turn4=energia(9)
451 edihcnstr=energia(19)
456 Eafmforce=energia(23)
457 ethetacnstr=energia(24)
460 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
461 & +wang*ebe+wtor*etors+wscloc*escloc
462 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
463 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
464 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
465 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+Eafmforce
466 & +ethetacnstr+wtube*Etube
468 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
469 & +wang*ebe+wtor*etors+wscloc*escloc
470 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
471 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
472 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
473 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
475 & +ethetacnstr+wtube*Etube
481 if (isnan(etot).ne.0) energia(0)=1.0d+99
483 if (isnan(etot)) energia(0)=1.0d+99
488 idumm=proc_proc(etot,i)
490 call proc_proc(etot,i)
492 if(i.eq.1)energia(0)=1.0d+99
499 c-------------------------------------------------------------------------------
500 subroutine sum_gradient
501 implicit real*8 (a-h,o-z)
506 cMS$ATTRIBUTES C :: proc_proc
512 double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
513 & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
514 & ,gloc_scbuf(3,-1:maxres)
515 include 'COMMON.SETUP'
516 include 'COMMON.IOUNITS'
517 include 'COMMON.FFIELD'
518 include 'COMMON.DERIV'
519 include 'COMMON.INTERACT'
520 include 'COMMON.SBRIDGE'
521 include 'COMMON.CHAIN'
523 include 'COMMON.CONTROL'
524 include 'COMMON.TIME1'
525 include 'COMMON.MAXGRAD'
526 include 'COMMON.SCCOR'
531 write (iout,*) "sum_gradient gvdwc, gvdwx"
533 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
534 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
539 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
540 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
541 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
544 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
545 C in virtual-bond-vector coordinates
548 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
550 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
551 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
553 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
555 c write (iout,'(i5,3f10.5,2x,f10.5)')
556 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
558 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
560 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
561 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
569 gradbufc(j,i)=wsc*gvdwc(j,i)+
570 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
571 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
572 & wel_loc*gel_loc_long(j,i)+
573 & wcorr*gradcorr_long(j,i)+
574 & wcorr5*gradcorr5_long(j,i)+
575 & wcorr6*gradcorr6_long(j,i)+
576 & wturn6*gcorr6_turn_long(j,i)+
578 & +wliptran*gliptranc(j,i)
580 & +welec*gshieldc(j,i)
581 & +wcorr*gshieldc_ec(j,i)
582 & +wturn3*gshieldc_t3(j,i)
583 & +wturn4*gshieldc_t4(j,i)
584 & +wel_loc*gshieldc_ll(j,i)
585 & +wtube*gg_tube(j,i)
594 gradbufc(j,i)=wsc*gvdwc(j,i)+
595 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
596 & welec*gelc_long(j,i)+
598 & wel_loc*gel_loc_long(j,i)+
599 & wcorr*gradcorr_long(j,i)+
600 & wcorr5*gradcorr5_long(j,i)+
601 & wcorr6*gradcorr6_long(j,i)+
602 & wturn6*gcorr6_turn_long(j,i)+
604 & +wliptran*gliptranc(j,i)
606 & +welec*gshieldc(j,i)
607 & +wcorr*gshieldc_ec(j,i)
608 & +wturn4*gshieldc_t4(j,i)
609 & +wel_loc*gshieldc_ll(j,i)
610 & +wtube*gg_tube(j,i)
618 if (nfgtasks.gt.1) then
621 write (iout,*) "gradbufc before allreduce"
623 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
629 gradbufc_sum(j,i)=gradbufc(j,i)
632 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
633 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
634 c time_reduce=time_reduce+MPI_Wtime()-time00
636 c write (iout,*) "gradbufc_sum after allreduce"
638 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
643 c time_allreduce=time_allreduce+MPI_Wtime()-time00
651 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
652 write (iout,*) (i," jgrad_start",jgrad_start(i),
653 & " jgrad_end ",jgrad_end(i),
654 & i=igrad_start,igrad_end)
657 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
658 c do not parallelize this part.
660 c do i=igrad_start,igrad_end
661 c do j=jgrad_start(i),jgrad_end(i)
663 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
668 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
672 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
676 write (iout,*) "gradbufc after summing"
678 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
685 write (iout,*) "gradbufc"
687 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
693 gradbufc_sum(j,i)=gradbufc(j,i)
698 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
702 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
707 c gradbufc(k,i)=0.0d0
711 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
716 write (iout,*) "gradbufc after summing"
718 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
726 gradbufc(k,nres)=0.0d0
731 C print *,gradbufc(1,13)
732 C print *,welec*gelc(1,13)
733 C print *,wel_loc*gel_loc(1,13)
734 C print *,0.5d0*(wscp*gvdwc_scpp(1,13))
735 C print *,welec*gelc_long(1,13)+wvdwpp*gvdwpp(1,13)
736 C print *,wel_loc*gel_loc_long(1,13)
737 C print *,gradafm(1,13),"AFM"
738 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
739 & wel_loc*gel_loc(j,i)+
740 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
741 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
742 & wel_loc*gel_loc_long(j,i)+
743 & wcorr*gradcorr_long(j,i)+
744 & wcorr5*gradcorr5_long(j,i)+
745 & wcorr6*gradcorr6_long(j,i)+
746 & wturn6*gcorr6_turn_long(j,i))+
748 & wcorr*gradcorr(j,i)+
749 & wturn3*gcorr3_turn(j,i)+
750 & wturn4*gcorr4_turn(j,i)+
751 & wcorr5*gradcorr5(j,i)+
752 & wcorr6*gradcorr6(j,i)+
753 & wturn6*gcorr6_turn(j,i)+
754 & wsccor*gsccorc(j,i)
755 & +wscloc*gscloc(j,i)
756 & +wliptran*gliptranc(j,i)
758 & +welec*gshieldc(j,i)
759 & +welec*gshieldc_loc(j,i)
760 & +wcorr*gshieldc_ec(j,i)
761 & +wcorr*gshieldc_loc_ec(j,i)
762 & +wturn3*gshieldc_t3(j,i)
763 & +wturn3*gshieldc_loc_t3(j,i)
764 & +wturn4*gshieldc_t4(j,i)
765 & +wturn4*gshieldc_loc_t4(j,i)
766 & +wel_loc*gshieldc_ll(j,i)
767 & +wel_loc*gshieldc_loc_ll(j,i)
768 & +wtube*gg_tube(j,i)
771 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
772 & wel_loc*gel_loc(j,i)+
773 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
774 & welec*gelc_long(j,i)+
775 & wel_loc*gel_loc_long(j,i)+
776 & wcorr*gcorr_long(j,i)+
777 & wcorr5*gradcorr5_long(j,i)+
778 & wcorr6*gradcorr6_long(j,i)+
779 & wturn6*gcorr6_turn_long(j,i))+
781 & wcorr*gradcorr(j,i)+
782 & wturn3*gcorr3_turn(j,i)+
783 & wturn4*gcorr4_turn(j,i)+
784 & wcorr5*gradcorr5(j,i)+
785 & wcorr6*gradcorr6(j,i)+
786 & wturn6*gcorr6_turn(j,i)+
787 & wsccor*gsccorc(j,i)
788 & +wscloc*gscloc(j,i)
789 & +wliptran*gliptranc(j,i)
791 & +welec*gshieldc(j,i)
792 & +welec*gshieldc_loc(j,i)
793 & +wcorr*gshieldc_ec(j,i)
794 & +wcorr*gshieldc_loc_ec(j,i)
795 & +wturn3*gshieldc_t3(j,i)
796 & +wturn3*gshieldc_loc_t3(j,i)
797 & +wturn4*gshieldc_t4(j,i)
798 & +wturn4*gshieldc_loc_t4(j,i)
799 & +wel_loc*gshieldc_ll(j,i)
800 & +wel_loc*gshieldc_loc_ll(j,i)
801 & +wtube*gg_tube(j,i)
805 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
807 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
808 & wsccor*gsccorx(j,i)
809 & +wscloc*gsclocx(j,i)
810 & +wliptran*gliptranx(j,i)
811 & +welec*gshieldx(j,i)
812 & +wcorr*gshieldx_ec(j,i)
813 & +wturn3*gshieldx_t3(j,i)
814 & +wturn4*gshieldx_t4(j,i)
815 & +wel_loc*gshieldx_ll(j,i)
816 & +wtube*gg_tube_sc(j,i)
823 write (iout,*) "gloc before adding corr"
825 write (iout,*) i,gloc(i,icg)
829 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
830 & +wcorr5*g_corr5_loc(i)
831 & +wcorr6*g_corr6_loc(i)
832 & +wturn4*gel_loc_turn4(i)
833 & +wturn3*gel_loc_turn3(i)
834 & +wturn6*gel_loc_turn6(i)
835 & +wel_loc*gel_loc_loc(i)
838 write (iout,*) "gloc after adding corr"
840 write (iout,*) i,gloc(i,icg)
844 if (nfgtasks.gt.1) then
847 gradbufc(j,i)=gradc(j,i,icg)
848 gradbufx(j,i)=gradx(j,i,icg)
852 glocbuf(i)=gloc(i,icg)
856 write (iout,*) "gloc_sc before reduce"
859 write (iout,*) i,j,gloc_sc(j,i,icg)
866 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
870 call MPI_Barrier(FG_COMM,IERR)
871 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
873 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
874 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
875 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
876 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
877 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
878 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
879 time_reduce=time_reduce+MPI_Wtime()-time00
880 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
881 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
882 time_reduce=time_reduce+MPI_Wtime()-time00
885 write (iout,*) "gloc_sc after reduce"
888 write (iout,*) i,j,gloc_sc(j,i,icg)
894 write (iout,*) "gloc after reduce"
896 write (iout,*) i,gloc(i,icg)
901 if (gnorm_check) then
903 c Compute the maximum elements of the gradient
913 gcorr3_turn_max=0.0d0
914 gcorr4_turn_max=0.0d0
917 gcorr6_turn_max=0.0d0
927 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
928 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
929 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
930 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
931 & gvdwc_scp_max=gvdwc_scp_norm
932 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
933 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
934 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
935 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
936 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
937 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
938 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
939 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
940 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
941 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
942 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
943 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
944 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
946 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
947 & gcorr3_turn_max=gcorr3_turn_norm
948 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
950 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
951 & gcorr4_turn_max=gcorr4_turn_norm
952 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
953 if (gradcorr5_norm.gt.gradcorr5_max)
954 & gradcorr5_max=gradcorr5_norm
955 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
956 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
957 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
959 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
960 & gcorr6_turn_max=gcorr6_turn_norm
961 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
962 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
963 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
964 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
965 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
966 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
967 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
968 if (gradx_scp_norm.gt.gradx_scp_max)
969 & gradx_scp_max=gradx_scp_norm
970 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
971 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
972 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
973 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
974 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
975 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
976 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
977 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
981 open(istat,file=statname,position="append")
983 open(istat,file=statname,access="append")
985 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
986 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
987 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
988 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
989 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
990 & gsccorx_max,gsclocx_max
992 if (gvdwc_max.gt.1.0d4) then
993 write (iout,*) "gvdwc gvdwx gradb gradbx"
995 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
996 & gradb(j,i),gradbx(j,i),j=1,3)
998 call pdbout(0.0d0,'cipiszcze',iout)
1004 write (iout,*) "gradc gradx gloc"
1006 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
1007 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
1011 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
1015 c-------------------------------------------------------------------------------
1016 subroutine rescale_weights(t_bath)
1017 implicit real*8 (a-h,o-z)
1018 include 'DIMENSIONS'
1019 include 'COMMON.IOUNITS'
1020 include 'COMMON.FFIELD'
1021 include 'COMMON.SBRIDGE'
1022 include 'COMMON.CONTROL'
1023 double precision kfac /2.4d0/
1024 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
1026 c facT=2*temp0/(t_bath+temp0)
1027 if (rescale_mode.eq.0) then
1033 else if (rescale_mode.eq.1) then
1034 facT=kfac/(kfac-1.0d0+t_bath/temp0)
1035 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1036 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1037 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1038 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1039 else if (rescale_mode.eq.2) then
1045 facT=licznik/dlog(dexp(x)+dexp(-x))
1046 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
1047 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
1048 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
1049 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
1051 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1052 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1054 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1058 if (shield_mode.gt.0) then
1059 wscp=weights(2)*fact
1061 wvdwpp=weights(16)*fact
1063 welec=weights(3)*fact
1064 wcorr=weights(4)*fact3
1065 wcorr5=weights(5)*fact4
1066 wcorr6=weights(6)*fact5
1067 wel_loc=weights(7)*fact2
1068 wturn3=weights(8)*fact2
1069 wturn4=weights(9)*fact3
1070 wturn6=weights(10)*fact5
1071 wtor=weights(13)*fact
1072 wtor_d=weights(14)*fact2
1073 wsccor=weights(21)*fact
1077 C------------------------------------------------------------------------
1078 subroutine enerprint(energia)
1079 implicit real*8 (a-h,o-z)
1080 include 'DIMENSIONS'
1081 include 'COMMON.IOUNITS'
1082 include 'COMMON.FFIELD'
1083 include 'COMMON.SBRIDGE'
1085 double precision energia(0:n_ene)
1090 evdw2=energia(2)+energia(18)
1102 eello_turn3=energia(8)
1103 eello_turn4=energia(9)
1104 eello_turn6=energia(10)
1110 edihcnstr=energia(19)
1114 eliptran=energia(22)
1115 Eafmforce=energia(23)
1116 ethetacnstr=energia(24)
1119 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1120 & estr,wbond,ebe,wang,
1121 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1123 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1124 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,
1125 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1128 10 format (/'Virtual-chain energies:'//
1129 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1130 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1131 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1132 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1133 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1134 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1135 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1136 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1137 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1138 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1139 & ' (SS bridges & dist. cnstr.)'/
1140 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1141 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1142 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1143 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1144 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1145 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1146 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1147 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1148 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1149 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1150 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1151 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1152 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1153 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1154 & 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/
1155 & 'ETOT= ',1pE16.6,' (total)')
1158 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1159 & estr,wbond,ebe,wang,
1160 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1162 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1163 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1164 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1167 10 format (/'Virtual-chain energies:'//
1168 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1169 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1170 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1171 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1172 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1173 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1174 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1175 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1176 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1177 & ' (SS bridges & dist. cnstr.)'/
1178 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1179 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1180 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1181 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1182 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1183 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1184 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1185 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1186 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1187 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1188 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1189 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1190 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1191 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1192 & 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/
1193 & 'ETOT= ',1pE16.6,' (total)')
1197 C-----------------------------------------------------------------------
1198 subroutine elj(evdw)
1200 C This subroutine calculates the interaction energy of nonbonded side chains
1201 C assuming the LJ potential of interaction.
1203 implicit real*8 (a-h,o-z)
1204 include 'DIMENSIONS'
1205 parameter (accur=1.0d-10)
1206 include 'COMMON.GEO'
1207 include 'COMMON.VAR'
1208 include 'COMMON.LOCAL'
1209 include 'COMMON.CHAIN'
1210 include 'COMMON.DERIV'
1211 include 'COMMON.INTERACT'
1212 include 'COMMON.TORSION'
1213 include 'COMMON.SBRIDGE'
1214 include 'COMMON.NAMES'
1215 include 'COMMON.IOUNITS'
1216 include 'COMMON.CONTACTS'
1218 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1220 do i=iatsc_s,iatsc_e
1221 itypi=iabs(itype(i))
1222 if (itypi.eq.ntyp1) cycle
1223 itypi1=iabs(itype(i+1))
1230 C Calculate SC interaction energy.
1232 do iint=1,nint_gr(i)
1233 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1234 cd & 'iend=',iend(i,iint)
1235 do j=istart(i,iint),iend(i,iint)
1236 itypj=iabs(itype(j))
1237 if (itypj.eq.ntyp1) cycle
1241 C Change 12/1/95 to calculate four-body interactions
1242 rij=xj*xj+yj*yj+zj*zj
1244 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1245 eps0ij=eps(itypi,itypj)
1247 C have you changed here?
1251 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1252 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1253 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1254 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1255 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1256 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1259 C Calculate the components of the gradient in DC and X
1261 fac=-rrij*(e1+evdwij)
1266 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1267 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1268 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1269 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1273 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1277 C 12/1/95, revised on 5/20/97
1279 C Calculate the contact function. The ith column of the array JCONT will
1280 C contain the numbers of atoms that make contacts with the atom I (of numbers
1281 C greater than I). The arrays FACONT and GACONT will contain the values of
1282 C the contact function and its derivative.
1284 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1285 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1286 C Uncomment next line, if the correlation interactions are contact function only
1287 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1289 sigij=sigma(itypi,itypj)
1290 r0ij=rs0(itypi,itypj)
1292 C Check whether the SC's are not too far to make a contact.
1295 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1296 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1298 if (fcont.gt.0.0D0) then
1299 C If the SC-SC distance if close to sigma, apply spline.
1300 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1301 cAdam & fcont1,fprimcont1)
1302 cAdam fcont1=1.0d0-fcont1
1303 cAdam if (fcont1.gt.0.0d0) then
1304 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1305 cAdam fcont=fcont*fcont1
1307 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1308 cga eps0ij=1.0d0/dsqrt(eps0ij)
1310 cga gg(k)=gg(k)*eps0ij
1312 cga eps0ij=-evdwij*eps0ij
1313 C Uncomment for AL's type of SC correlation interactions.
1314 cadam eps0ij=-evdwij
1315 num_conti=num_conti+1
1316 jcont(num_conti,i)=j
1317 facont(num_conti,i)=fcont*eps0ij
1318 fprimcont=eps0ij*fprimcont/rij
1320 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1321 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1322 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1323 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1324 gacont(1,num_conti,i)=-fprimcont*xj
1325 gacont(2,num_conti,i)=-fprimcont*yj
1326 gacont(3,num_conti,i)=-fprimcont*zj
1327 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1328 cd write (iout,'(2i3,3f10.5)')
1329 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1335 num_cont(i)=num_conti
1339 gvdwc(j,i)=expon*gvdwc(j,i)
1340 gvdwx(j,i)=expon*gvdwx(j,i)
1343 C******************************************************************************
1347 C To save time, the factor of EXPON has been extracted from ALL components
1348 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1351 C******************************************************************************
1354 C-----------------------------------------------------------------------------
1355 subroutine eljk(evdw)
1357 C This subroutine calculates the interaction energy of nonbonded side chains
1358 C assuming the LJK potential of interaction.
1360 implicit real*8 (a-h,o-z)
1361 include 'DIMENSIONS'
1362 include 'COMMON.GEO'
1363 include 'COMMON.VAR'
1364 include 'COMMON.LOCAL'
1365 include 'COMMON.CHAIN'
1366 include 'COMMON.DERIV'
1367 include 'COMMON.INTERACT'
1368 include 'COMMON.IOUNITS'
1369 include 'COMMON.NAMES'
1372 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1374 do i=iatsc_s,iatsc_e
1375 itypi=iabs(itype(i))
1376 if (itypi.eq.ntyp1) cycle
1377 itypi1=iabs(itype(i+1))
1382 C Calculate SC interaction energy.
1384 do iint=1,nint_gr(i)
1385 do j=istart(i,iint),iend(i,iint)
1386 itypj=iabs(itype(j))
1387 if (itypj.eq.ntyp1) cycle
1391 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1392 fac_augm=rrij**expon
1393 e_augm=augm(itypi,itypj)*fac_augm
1394 r_inv_ij=dsqrt(rrij)
1396 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1397 fac=r_shift_inv**expon
1398 C have you changed here?
1402 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1403 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1404 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1405 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1406 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1407 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1408 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1411 C Calculate the components of the gradient in DC and X
1413 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1418 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1419 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1420 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1421 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1425 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1433 gvdwc(j,i)=expon*gvdwc(j,i)
1434 gvdwx(j,i)=expon*gvdwx(j,i)
1439 C-----------------------------------------------------------------------------
1440 subroutine ebp(evdw)
1442 C This subroutine calculates the interaction energy of nonbonded side chains
1443 C assuming the Berne-Pechukas potential of interaction.
1445 implicit real*8 (a-h,o-z)
1446 include 'DIMENSIONS'
1447 include 'COMMON.GEO'
1448 include 'COMMON.VAR'
1449 include 'COMMON.LOCAL'
1450 include 'COMMON.CHAIN'
1451 include 'COMMON.DERIV'
1452 include 'COMMON.NAMES'
1453 include 'COMMON.INTERACT'
1454 include 'COMMON.IOUNITS'
1455 include 'COMMON.CALC'
1456 common /srutu/ icall
1457 c double precision rrsave(maxdim)
1460 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1462 c if (icall.eq.0) then
1468 do i=iatsc_s,iatsc_e
1469 itypi=iabs(itype(i))
1470 if (itypi.eq.ntyp1) cycle
1471 itypi1=iabs(itype(i+1))
1475 dxi=dc_norm(1,nres+i)
1476 dyi=dc_norm(2,nres+i)
1477 dzi=dc_norm(3,nres+i)
1478 c dsci_inv=dsc_inv(itypi)
1479 dsci_inv=vbld_inv(i+nres)
1481 C Calculate SC interaction energy.
1483 do iint=1,nint_gr(i)
1484 do j=istart(i,iint),iend(i,iint)
1486 itypj=iabs(itype(j))
1487 if (itypj.eq.ntyp1) cycle
1488 c dscj_inv=dsc_inv(itypj)
1489 dscj_inv=vbld_inv(j+nres)
1490 chi1=chi(itypi,itypj)
1491 chi2=chi(itypj,itypi)
1498 alf12=0.5D0*(alf1+alf2)
1499 C For diagnostics only!!!
1512 dxj=dc_norm(1,nres+j)
1513 dyj=dc_norm(2,nres+j)
1514 dzj=dc_norm(3,nres+j)
1515 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1516 cd if (icall.eq.0) then
1522 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1524 C Calculate whole angle-dependent part of epsilon and contributions
1525 C to its derivatives
1526 C have you changed here?
1527 fac=(rrij*sigsq)**expon2
1530 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1531 eps2der=evdwij*eps3rt
1532 eps3der=evdwij*eps2rt
1533 evdwij=evdwij*eps2rt*eps3rt
1536 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1538 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1539 cd & restyp(itypi),i,restyp(itypj),j,
1540 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1541 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1542 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1545 C Calculate gradient components.
1546 e1=e1*eps1*eps2rt**2*eps3rt**2
1547 fac=-expon*(e1+evdwij)
1550 C Calculate radial part of the gradient
1554 C Calculate the angular part of the gradient and sum add the contributions
1555 C to the appropriate components of the Cartesian gradient.
1563 C-----------------------------------------------------------------------------
1564 subroutine egb(evdw)
1566 C This subroutine calculates the interaction energy of nonbonded side chains
1567 C assuming the Gay-Berne potential of interaction.
1569 implicit real*8 (a-h,o-z)
1570 include 'DIMENSIONS'
1571 include 'COMMON.GEO'
1572 include 'COMMON.VAR'
1573 include 'COMMON.LOCAL'
1574 include 'COMMON.CHAIN'
1575 include 'COMMON.DERIV'
1576 include 'COMMON.NAMES'
1577 include 'COMMON.INTERACT'
1578 include 'COMMON.IOUNITS'
1579 include 'COMMON.CALC'
1580 include 'COMMON.CONTROL'
1581 include 'COMMON.SPLITELE'
1582 include 'COMMON.SBRIDGE'
1584 integer xshift,yshift,zshift
1587 ccccc energy_dec=.false.
1588 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1591 c if (icall.eq.0) lprn=.false.
1593 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1594 C we have the original box)
1598 do i=iatsc_s,iatsc_e
1599 itypi=iabs(itype(i))
1600 if (itypi.eq.ntyp1) cycle
1601 itypi1=iabs(itype(i+1))
1605 C Return atom into box, boxxsize is size of box in x dimension
1607 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1608 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1609 C Condition for being inside the proper box
1610 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1611 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1615 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1616 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1617 C Condition for being inside the proper box
1618 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1619 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1623 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1624 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1625 C Condition for being inside the proper box
1626 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1627 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1631 if (xi.lt.0) xi=xi+boxxsize
1633 if (yi.lt.0) yi=yi+boxysize
1635 if (zi.lt.0) zi=zi+boxzsize
1636 C define scaling factor for lipids
1638 C if (positi.le.0) positi=positi+boxzsize
1640 C first for peptide groups
1641 c for each residue check if it is in lipid or lipid water border area
1642 if ((zi.gt.bordlipbot)
1643 &.and.(zi.lt.bordliptop)) then
1644 C the energy transfer exist
1645 if (zi.lt.buflipbot) then
1646 C what fraction I am in
1648 & ((zi-bordlipbot)/lipbufthick)
1649 C lipbufthick is thickenes of lipid buffore
1650 sslipi=sscalelip(fracinbuf)
1651 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1652 elseif (zi.gt.bufliptop) then
1653 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1654 sslipi=sscalelip(fracinbuf)
1655 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1665 C xi=xi+xshift*boxxsize
1666 C yi=yi+yshift*boxysize
1667 C zi=zi+zshift*boxzsize
1669 dxi=dc_norm(1,nres+i)
1670 dyi=dc_norm(2,nres+i)
1671 dzi=dc_norm(3,nres+i)
1672 c dsci_inv=dsc_inv(itypi)
1673 dsci_inv=vbld_inv(i+nres)
1674 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1675 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1677 C Calculate SC interaction energy.
1679 do iint=1,nint_gr(i)
1680 do j=istart(i,iint),iend(i,iint)
1681 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1683 c write(iout,*) "PRZED ZWYKLE", evdwij
1684 call dyn_ssbond_ene(i,j,evdwij)
1685 c write(iout,*) "PO ZWYKLE", evdwij
1688 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1689 & 'evdw',i,j,evdwij,' ss'
1690 C triple bond artifac removal
1691 do k=j+1,iend(i,iint)
1692 C search over all next residues
1693 if (dyn_ss_mask(k)) then
1694 C check if they are cysteins
1695 C write(iout,*) 'k=',k
1697 c write(iout,*) "PRZED TRI", evdwij
1698 evdwij_przed_tri=evdwij
1699 call triple_ssbond_ene(i,j,k,evdwij)
1700 c if(evdwij_przed_tri.ne.evdwij) then
1701 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1704 c write(iout,*) "PO TRI", evdwij
1705 C call the energy function that removes the artifical triple disulfide
1706 C bond the soubroutine is located in ssMD.F
1708 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1709 & 'evdw',i,j,evdwij,'tss'
1710 endif!dyn_ss_mask(k)
1714 itypj=iabs(itype(j))
1715 if (itypj.eq.ntyp1) cycle
1716 c dscj_inv=dsc_inv(itypj)
1717 dscj_inv=vbld_inv(j+nres)
1718 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1719 c & 1.0d0/vbld(j+nres)
1720 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1721 sig0ij=sigma(itypi,itypj)
1722 chi1=chi(itypi,itypj)
1723 chi2=chi(itypj,itypi)
1730 alf12=0.5D0*(alf1+alf2)
1731 C For diagnostics only!!!
1744 C Return atom J into box the original box
1746 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1747 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1748 C Condition for being inside the proper box
1749 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1750 c & (xj.lt.((-0.5d0)*boxxsize))) then
1754 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1755 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1756 C Condition for being inside the proper box
1757 c if ((yj.gt.((0.5d0)*boxysize)).or.
1758 c & (yj.lt.((-0.5d0)*boxysize))) then
1762 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1763 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1764 C Condition for being inside the proper box
1765 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1766 c & (zj.lt.((-0.5d0)*boxzsize))) then
1770 if (xj.lt.0) xj=xj+boxxsize
1772 if (yj.lt.0) yj=yj+boxysize
1774 if (zj.lt.0) zj=zj+boxzsize
1775 if ((zj.gt.bordlipbot)
1776 &.and.(zj.lt.bordliptop)) then
1777 C the energy transfer exist
1778 if (zj.lt.buflipbot) then
1779 C what fraction I am in
1781 & ((zj-bordlipbot)/lipbufthick)
1782 C lipbufthick is thickenes of lipid buffore
1783 sslipj=sscalelip(fracinbuf)
1784 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1785 elseif (zj.gt.bufliptop) then
1786 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1787 sslipj=sscalelip(fracinbuf)
1788 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1797 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1798 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1799 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1800 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1801 C write(iout,*) "tu,", i,j,aa_lip(itypi,itypj),bb_lip(itypi,itypj)
1802 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1803 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1804 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1805 C print *,sslipi,sslipj,bordlipbot,zi,zj
1806 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1814 xj=xj_safe+xshift*boxxsize
1815 yj=yj_safe+yshift*boxysize
1816 zj=zj_safe+zshift*boxzsize
1817 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1818 if(dist_temp.lt.dist_init) then
1828 if (subchap.eq.1) then
1837 dxj=dc_norm(1,nres+j)
1838 dyj=dc_norm(2,nres+j)
1839 dzj=dc_norm(3,nres+j)
1843 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1844 c write (iout,*) "j",j," dc_norm",
1845 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1846 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1848 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1849 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1851 c write (iout,'(a7,4f8.3)')
1852 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1853 if (sss.gt.0.0d0) then
1854 C Calculate angle-dependent terms of energy and contributions to their
1858 sig=sig0ij*dsqrt(sigsq)
1859 rij_shift=1.0D0/rij-sig+sig0ij
1860 c for diagnostics; uncomment
1861 c rij_shift=1.2*sig0ij
1862 C I hate to put IF's in the loops, but here don't have another choice!!!!
1863 if (rij_shift.le.0.0D0) then
1865 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1866 cd & restyp(itypi),i,restyp(itypj),j,
1867 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1871 c---------------------------------------------------------------
1872 rij_shift=1.0D0/rij_shift
1873 fac=rij_shift**expon
1874 C here to start with
1879 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1880 eps2der=evdwij*eps3rt
1881 eps3der=evdwij*eps2rt
1882 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1883 C &((sslipi+sslipj)/2.0d0+
1884 C &(2.0d0-sslipi-sslipj)/2.0d0)
1885 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1886 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1887 evdwij=evdwij*eps2rt*eps3rt
1888 evdw=evdw+evdwij*sss
1890 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1892 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1893 & restyp(itypi),i,restyp(itypj),j,
1894 & epsi,sigm,chi1,chi2,chip1,chip2,
1895 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1896 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1900 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1903 C Calculate gradient components.
1904 e1=e1*eps1*eps2rt**2*eps3rt**2
1905 fac=-expon*(e1+evdwij)*rij_shift
1908 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1909 c & evdwij,fac,sigma(itypi,itypj),expon
1910 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1912 C Calculate the radial part of the gradient
1913 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1914 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1915 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1916 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1917 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1918 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1924 C Calculate angular part of the gradient.
1934 c write (iout,*) "Number of loop steps in EGB:",ind
1935 cccc energy_dec=.false.
1938 C-----------------------------------------------------------------------------
1939 subroutine egbv(evdw)
1941 C This subroutine calculates the interaction energy of nonbonded side chains
1942 C assuming the Gay-Berne-Vorobjev potential of interaction.
1944 implicit real*8 (a-h,o-z)
1945 include 'DIMENSIONS'
1946 include 'COMMON.GEO'
1947 include 'COMMON.VAR'
1948 include 'COMMON.LOCAL'
1949 include 'COMMON.CHAIN'
1950 include 'COMMON.DERIV'
1951 include 'COMMON.NAMES'
1952 include 'COMMON.INTERACT'
1953 include 'COMMON.IOUNITS'
1954 include 'COMMON.CALC'
1955 common /srutu/ icall
1958 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1961 c if (icall.eq.0) lprn=.true.
1963 do i=iatsc_s,iatsc_e
1964 itypi=iabs(itype(i))
1965 if (itypi.eq.ntyp1) cycle
1966 itypi1=iabs(itype(i+1))
1971 if (xi.lt.0) xi=xi+boxxsize
1973 if (yi.lt.0) yi=yi+boxysize
1975 if (zi.lt.0) zi=zi+boxzsize
1976 C define scaling factor for lipids
1978 C if (positi.le.0) positi=positi+boxzsize
1980 C first for peptide groups
1981 c for each residue check if it is in lipid or lipid water border area
1982 if ((zi.gt.bordlipbot)
1983 &.and.(zi.lt.bordliptop)) then
1984 C the energy transfer exist
1985 if (zi.lt.buflipbot) then
1986 C what fraction I am in
1988 & ((zi-bordlipbot)/lipbufthick)
1989 C lipbufthick is thickenes of lipid buffore
1990 sslipi=sscalelip(fracinbuf)
1991 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1992 elseif (zi.gt.bufliptop) then
1993 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1994 sslipi=sscalelip(fracinbuf)
1995 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
2005 dxi=dc_norm(1,nres+i)
2006 dyi=dc_norm(2,nres+i)
2007 dzi=dc_norm(3,nres+i)
2008 c dsci_inv=dsc_inv(itypi)
2009 dsci_inv=vbld_inv(i+nres)
2011 C Calculate SC interaction energy.
2013 do iint=1,nint_gr(i)
2014 do j=istart(i,iint),iend(i,iint)
2016 itypj=iabs(itype(j))
2017 if (itypj.eq.ntyp1) cycle
2018 c dscj_inv=dsc_inv(itypj)
2019 dscj_inv=vbld_inv(j+nres)
2020 sig0ij=sigma(itypi,itypj)
2021 r0ij=r0(itypi,itypj)
2022 chi1=chi(itypi,itypj)
2023 chi2=chi(itypj,itypi)
2030 alf12=0.5D0*(alf1+alf2)
2031 C For diagnostics only!!!
2045 if (xj.lt.0) xj=xj+boxxsize
2047 if (yj.lt.0) yj=yj+boxysize
2049 if (zj.lt.0) zj=zj+boxzsize
2050 if ((zj.gt.bordlipbot)
2051 &.and.(zj.lt.bordliptop)) then
2052 C the energy transfer exist
2053 if (zj.lt.buflipbot) then
2054 C what fraction I am in
2056 & ((zj-bordlipbot)/lipbufthick)
2057 C lipbufthick is thickenes of lipid buffore
2058 sslipj=sscalelip(fracinbuf)
2059 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
2060 elseif (zj.gt.bufliptop) then
2061 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
2062 sslipj=sscalelip(fracinbuf)
2063 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
2072 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
2073 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2074 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
2075 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2076 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
2077 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
2078 C write(iout,*) "tu,", i,j,aa,bb,aa_lip(itypi,itypj),sslipi,sslipj
2079 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2087 xj=xj_safe+xshift*boxxsize
2088 yj=yj_safe+yshift*boxysize
2089 zj=zj_safe+zshift*boxzsize
2090 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2091 if(dist_temp.lt.dist_init) then
2101 if (subchap.eq.1) then
2110 dxj=dc_norm(1,nres+j)
2111 dyj=dc_norm(2,nres+j)
2112 dzj=dc_norm(3,nres+j)
2113 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2115 C Calculate angle-dependent terms of energy and contributions to their
2119 sig=sig0ij*dsqrt(sigsq)
2120 rij_shift=1.0D0/rij-sig+r0ij
2121 C I hate to put IF's in the loops, but here don't have another choice!!!!
2122 if (rij_shift.le.0.0D0) then
2127 c---------------------------------------------------------------
2128 rij_shift=1.0D0/rij_shift
2129 fac=rij_shift**expon
2132 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2133 eps2der=evdwij*eps3rt
2134 eps3der=evdwij*eps2rt
2135 fac_augm=rrij**expon
2136 e_augm=augm(itypi,itypj)*fac_augm
2137 evdwij=evdwij*eps2rt*eps3rt
2138 evdw=evdw+evdwij+e_augm
2140 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2142 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2143 & restyp(itypi),i,restyp(itypj),j,
2144 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2145 & chi1,chi2,chip1,chip2,
2146 & eps1,eps2rt**2,eps3rt**2,
2147 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2150 C Calculate gradient components.
2151 e1=e1*eps1*eps2rt**2*eps3rt**2
2152 fac=-expon*(e1+evdwij)*rij_shift
2154 fac=rij*fac-2*expon*rrij*e_augm
2155 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2156 C Calculate the radial part of the gradient
2160 C Calculate angular part of the gradient.
2166 C-----------------------------------------------------------------------------
2167 subroutine sc_angular
2168 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2169 C om12. Called by ebp, egb, and egbv.
2171 include 'COMMON.CALC'
2172 include 'COMMON.IOUNITS'
2176 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2177 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2178 om12=dxi*dxj+dyi*dyj+dzi*dzj
2180 C Calculate eps1(om12) and its derivative in om12
2181 faceps1=1.0D0-om12*chiom12
2182 faceps1_inv=1.0D0/faceps1
2183 eps1=dsqrt(faceps1_inv)
2184 C Following variable is eps1*deps1/dom12
2185 eps1_om12=faceps1_inv*chiom12
2190 c write (iout,*) "om12",om12," eps1",eps1
2191 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2196 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2197 sigsq=1.0D0-facsig*faceps1_inv
2198 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2199 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2200 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2206 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2207 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2209 C Calculate eps2 and its derivatives in om1, om2, and om12.
2212 chipom12=chip12*om12
2213 facp=1.0D0-om12*chipom12
2215 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2216 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2217 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2218 C Following variable is the square root of eps2
2219 eps2rt=1.0D0-facp1*facp_inv
2220 C Following three variables are the derivatives of the square root of eps
2221 C in om1, om2, and om12.
2222 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2223 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2224 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2225 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2226 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2227 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2228 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2229 c & " eps2rt_om12",eps2rt_om12
2230 C Calculate whole angle-dependent part of epsilon and contributions
2231 C to its derivatives
2234 C----------------------------------------------------------------------------
2236 implicit real*8 (a-h,o-z)
2237 include 'DIMENSIONS'
2238 include 'COMMON.CHAIN'
2239 include 'COMMON.DERIV'
2240 include 'COMMON.CALC'
2241 include 'COMMON.IOUNITS'
2242 double precision dcosom1(3),dcosom2(3)
2243 cc print *,'sss=',sss
2244 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2245 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2246 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2247 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2251 c eom12=evdwij*eps1_om12
2253 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2254 c & " sigder",sigder
2255 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2256 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2258 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2259 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2262 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2264 c write (iout,*) "gg",(gg(k),k=1,3)
2266 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2267 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2268 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2269 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2270 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2271 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2272 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2273 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2274 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2275 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2278 C Calculate the components of the gradient in DC and X
2282 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2286 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2287 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2291 C-----------------------------------------------------------------------
2292 subroutine e_softsphere(evdw)
2294 C This subroutine calculates the interaction energy of nonbonded side chains
2295 C assuming the LJ potential of interaction.
2297 implicit real*8 (a-h,o-z)
2298 include 'DIMENSIONS'
2299 parameter (accur=1.0d-10)
2300 include 'COMMON.GEO'
2301 include 'COMMON.VAR'
2302 include 'COMMON.LOCAL'
2303 include 'COMMON.CHAIN'
2304 include 'COMMON.DERIV'
2305 include 'COMMON.INTERACT'
2306 include 'COMMON.TORSION'
2307 include 'COMMON.SBRIDGE'
2308 include 'COMMON.NAMES'
2309 include 'COMMON.IOUNITS'
2310 include 'COMMON.CONTACTS'
2312 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2314 do i=iatsc_s,iatsc_e
2315 itypi=iabs(itype(i))
2316 if (itypi.eq.ntyp1) cycle
2317 itypi1=iabs(itype(i+1))
2322 C Calculate SC interaction energy.
2324 do iint=1,nint_gr(i)
2325 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2326 cd & 'iend=',iend(i,iint)
2327 do j=istart(i,iint),iend(i,iint)
2328 itypj=iabs(itype(j))
2329 if (itypj.eq.ntyp1) cycle
2333 rij=xj*xj+yj*yj+zj*zj
2334 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2335 r0ij=r0(itypi,itypj)
2337 c print *,i,j,r0ij,dsqrt(rij)
2338 if (rij.lt.r0ijsq) then
2339 evdwij=0.25d0*(rij-r0ijsq)**2
2347 C Calculate the components of the gradient in DC and X
2353 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2354 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2355 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2356 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2360 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2368 C--------------------------------------------------------------------------
2369 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2372 C Soft-sphere potential of p-p interaction
2374 implicit real*8 (a-h,o-z)
2375 include 'DIMENSIONS'
2376 include 'COMMON.CONTROL'
2377 include 'COMMON.IOUNITS'
2378 include 'COMMON.GEO'
2379 include 'COMMON.VAR'
2380 include 'COMMON.LOCAL'
2381 include 'COMMON.CHAIN'
2382 include 'COMMON.DERIV'
2383 include 'COMMON.INTERACT'
2384 include 'COMMON.CONTACTS'
2385 include 'COMMON.TORSION'
2386 include 'COMMON.VECTORS'
2387 include 'COMMON.FFIELD'
2389 C write(iout,*) 'In EELEC_soft_sphere'
2396 do i=iatel_s,iatel_e
2397 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2401 xmedi=c(1,i)+0.5d0*dxi
2402 ymedi=c(2,i)+0.5d0*dyi
2403 zmedi=c(3,i)+0.5d0*dzi
2404 xmedi=mod(xmedi,boxxsize)
2405 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2406 ymedi=mod(ymedi,boxysize)
2407 if (ymedi.lt.0) ymedi=ymedi+boxysize
2408 zmedi=mod(zmedi,boxzsize)
2409 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2411 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2412 do j=ielstart(i),ielend(i)
2413 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2417 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2418 r0ij=rpp(iteli,itelj)
2427 if (xj.lt.0) xj=xj+boxxsize
2429 if (yj.lt.0) yj=yj+boxysize
2431 if (zj.lt.0) zj=zj+boxzsize
2432 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2440 xj=xj_safe+xshift*boxxsize
2441 yj=yj_safe+yshift*boxysize
2442 zj=zj_safe+zshift*boxzsize
2443 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2444 if(dist_temp.lt.dist_init) then
2454 if (isubchap.eq.1) then
2463 rij=xj*xj+yj*yj+zj*zj
2464 sss=sscale(sqrt(rij))
2465 sssgrad=sscagrad(sqrt(rij))
2466 if (rij.lt.r0ijsq) then
2467 evdw1ij=0.25d0*(rij-r0ijsq)**2
2473 evdw1=evdw1+evdw1ij*sss
2475 C Calculate contributions to the Cartesian gradient.
2477 ggg(1)=fac*xj*sssgrad
2478 ggg(2)=fac*yj*sssgrad
2479 ggg(3)=fac*zj*sssgrad
2481 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2482 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2485 * Loop over residues i+1 thru j-1.
2489 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2494 cgrad do i=nnt,nct-1
2496 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2498 cgrad do j=i+1,nct-1
2500 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2506 c------------------------------------------------------------------------------
2507 subroutine vec_and_deriv
2508 implicit real*8 (a-h,o-z)
2509 include 'DIMENSIONS'
2513 include 'COMMON.IOUNITS'
2514 include 'COMMON.GEO'
2515 include 'COMMON.VAR'
2516 include 'COMMON.LOCAL'
2517 include 'COMMON.CHAIN'
2518 include 'COMMON.VECTORS'
2519 include 'COMMON.SETUP'
2520 include 'COMMON.TIME1'
2521 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2522 C Compute the local reference systems. For reference system (i), the
2523 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2524 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2526 do i=ivec_start,ivec_end
2530 if (i.eq.nres-1) then
2531 C Case of the last full residue
2532 C Compute the Z-axis
2533 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2534 costh=dcos(pi-theta(nres))
2535 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2539 C Compute the derivatives of uz
2541 uzder(2,1,1)=-dc_norm(3,i-1)
2542 uzder(3,1,1)= dc_norm(2,i-1)
2543 uzder(1,2,1)= dc_norm(3,i-1)
2545 uzder(3,2,1)=-dc_norm(1,i-1)
2546 uzder(1,3,1)=-dc_norm(2,i-1)
2547 uzder(2,3,1)= dc_norm(1,i-1)
2550 uzder(2,1,2)= dc_norm(3,i)
2551 uzder(3,1,2)=-dc_norm(2,i)
2552 uzder(1,2,2)=-dc_norm(3,i)
2554 uzder(3,2,2)= dc_norm(1,i)
2555 uzder(1,3,2)= dc_norm(2,i)
2556 uzder(2,3,2)=-dc_norm(1,i)
2558 C Compute the Y-axis
2561 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2563 C Compute the derivatives of uy
2566 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2567 & -dc_norm(k,i)*dc_norm(j,i-1)
2568 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2570 uyder(j,j,1)=uyder(j,j,1)-costh
2571 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2576 uygrad(l,k,j,i)=uyder(l,k,j)
2577 uzgrad(l,k,j,i)=uzder(l,k,j)
2581 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2582 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2583 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2584 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2587 C Compute the Z-axis
2588 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2589 costh=dcos(pi-theta(i+2))
2590 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2594 C Compute the derivatives of uz
2596 uzder(2,1,1)=-dc_norm(3,i+1)
2597 uzder(3,1,1)= dc_norm(2,i+1)
2598 uzder(1,2,1)= dc_norm(3,i+1)
2600 uzder(3,2,1)=-dc_norm(1,i+1)
2601 uzder(1,3,1)=-dc_norm(2,i+1)
2602 uzder(2,3,1)= dc_norm(1,i+1)
2605 uzder(2,1,2)= dc_norm(3,i)
2606 uzder(3,1,2)=-dc_norm(2,i)
2607 uzder(1,2,2)=-dc_norm(3,i)
2609 uzder(3,2,2)= dc_norm(1,i)
2610 uzder(1,3,2)= dc_norm(2,i)
2611 uzder(2,3,2)=-dc_norm(1,i)
2613 C Compute the Y-axis
2616 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2618 C Compute the derivatives of uy
2621 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2622 & -dc_norm(k,i)*dc_norm(j,i+1)
2623 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2625 uyder(j,j,1)=uyder(j,j,1)-costh
2626 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2631 uygrad(l,k,j,i)=uyder(l,k,j)
2632 uzgrad(l,k,j,i)=uzder(l,k,j)
2636 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2637 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2638 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2639 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2643 vbld_inv_temp(1)=vbld_inv(i+1)
2644 if (i.lt.nres-1) then
2645 vbld_inv_temp(2)=vbld_inv(i+2)
2647 vbld_inv_temp(2)=vbld_inv(i)
2652 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2653 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2658 #if defined(PARVEC) && defined(MPI)
2659 if (nfgtasks1.gt.1) then
2661 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2662 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2663 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2664 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2665 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2667 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2668 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2670 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2671 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2672 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2673 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2674 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2675 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2676 time_gather=time_gather+MPI_Wtime()-time00
2678 c if (fg_rank.eq.0) then
2679 c write (iout,*) "Arrays UY and UZ"
2681 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2688 C-----------------------------------------------------------------------------
2689 subroutine check_vecgrad
2690 implicit real*8 (a-h,o-z)
2691 include 'DIMENSIONS'
2692 include 'COMMON.IOUNITS'
2693 include 'COMMON.GEO'
2694 include 'COMMON.VAR'
2695 include 'COMMON.LOCAL'
2696 include 'COMMON.CHAIN'
2697 include 'COMMON.VECTORS'
2698 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2699 dimension uyt(3,maxres),uzt(3,maxres)
2700 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2701 double precision delta /1.0d-7/
2704 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2705 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2706 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2707 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2708 cd & (dc_norm(if90,i),if90=1,3)
2709 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2710 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2711 cd write(iout,'(a)')
2717 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2718 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2731 cd write (iout,*) 'i=',i
2733 erij(k)=dc_norm(k,i)
2737 dc_norm(k,i)=erij(k)
2739 dc_norm(j,i)=dc_norm(j,i)+delta
2740 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2742 c dc_norm(k,i)=dc_norm(k,i)/fac
2744 c write (iout,*) (dc_norm(k,i),k=1,3)
2745 c write (iout,*) (erij(k),k=1,3)
2748 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2749 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2750 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2751 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2753 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2754 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2755 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2758 dc_norm(k,i)=erij(k)
2761 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2762 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2763 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2764 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2765 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2766 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2767 cd write (iout,'(a)')
2772 C--------------------------------------------------------------------------
2773 subroutine set_matrices
2774 implicit real*8 (a-h,o-z)
2775 include 'DIMENSIONS'
2778 include "COMMON.SETUP"
2780 integer status(MPI_STATUS_SIZE)
2782 include 'COMMON.IOUNITS'
2783 include 'COMMON.GEO'
2784 include 'COMMON.VAR'
2785 include 'COMMON.LOCAL'
2786 include 'COMMON.CHAIN'
2787 include 'COMMON.DERIV'
2788 include 'COMMON.INTERACT'
2789 include 'COMMON.CONTACTS'
2790 include 'COMMON.TORSION'
2791 include 'COMMON.VECTORS'
2792 include 'COMMON.FFIELD'
2793 double precision auxvec(2),auxmat(2,2)
2795 C Compute the virtual-bond-torsional-angle dependent quantities needed
2796 C to calculate the el-loc multibody terms of various order.
2798 c write(iout,*) 'nphi=',nphi,nres
2800 do i=ivec_start+2,ivec_end+2
2805 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2806 iti = itype2loc(itype(i-2))
2810 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2811 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2812 iti1 = itype2loc(itype(i-1))
2817 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0d0)
2818 & +bnew1(2,1,iti)*dsin(theta(i-1))
2819 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0d0)
2820 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2821 & +bnew1(2,1,iti)*dcos(theta(i-1))
2822 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2823 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2824 c &*(cos(theta(i)/2.0)
2825 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0d0)
2826 & +bnew2(2,1,iti)*dsin(theta(i-1))
2827 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0d0)
2828 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2829 c &*(cos(theta(i)/2.0)
2830 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2831 & +bnew2(2,1,iti)*dcos(theta(i-1))
2832 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2833 c if (ggb1(1,i).eq.0.0d0) then
2834 c write(iout,*) 'i=',i,ggb1(1,i),
2835 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2836 c &bnew1(2,1,iti)*cos(theta(i)),
2837 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2839 b1(2,i-2)=bnew1(1,2,iti)
2841 b2(2,i-2)=bnew2(1,2,iti)
2843 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2844 EE(1,2,i-2)=eeold(1,2,iti)
2845 EE(2,1,i-2)=eeold(2,1,iti)
2846 EE(2,2,i-2)=eeold(2,2,iti)
2847 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2852 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2853 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2854 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2855 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2856 b1tilde(1,i-2)=b1(1,i-2)
2857 b1tilde(2,i-2)=-b1(2,i-2)
2858 b2tilde(1,i-2)=b2(1,i-2)
2859 b2tilde(2,i-2)=-b2(2,i-2)
2860 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2861 c write(iout,*) 'b1=',b1(1,i-2)
2862 c write (iout,*) 'theta=', theta(i-1)
2865 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2866 iti = itype2loc(itype(i-2))
2870 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2871 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2872 iti1 = itype2loc(itype(i-1))
2880 b1tilde(1,i-2)=b1(1,i-2)
2881 b1tilde(2,i-2)=-b1(2,i-2)
2882 b2tilde(1,i-2)=b2(1,i-2)
2883 b2tilde(2,i-2)=-b2(2,i-2)
2884 EE(1,2,i-2)=eeold(1,2,iti)
2885 EE(2,1,i-2)=eeold(2,1,iti)
2886 EE(2,2,i-2)=eeold(2,2,iti)
2887 EE(1,1,i-2)=eeold(1,1,iti)
2891 do i=ivec_start+2,ivec_end+2
2895 if (i .lt. nres+1) then
2932 if (i .gt. 3 .and. i .lt. nres+1) then
2933 obrot_der(1,i-2)=-sin1
2934 obrot_der(2,i-2)= cos1
2935 Ugder(1,1,i-2)= sin1
2936 Ugder(1,2,i-2)=-cos1
2937 Ugder(2,1,i-2)=-cos1
2938 Ugder(2,2,i-2)=-sin1
2941 obrot2_der(1,i-2)=-dwasin2
2942 obrot2_der(2,i-2)= dwacos2
2943 Ug2der(1,1,i-2)= dwasin2
2944 Ug2der(1,2,i-2)=-dwacos2
2945 Ug2der(2,1,i-2)=-dwacos2
2946 Ug2der(2,2,i-2)=-dwasin2
2948 obrot_der(1,i-2)=0.0d0
2949 obrot_der(2,i-2)=0.0d0
2950 Ugder(1,1,i-2)=0.0d0
2951 Ugder(1,2,i-2)=0.0d0
2952 Ugder(2,1,i-2)=0.0d0
2953 Ugder(2,2,i-2)=0.0d0
2954 obrot2_der(1,i-2)=0.0d0
2955 obrot2_der(2,i-2)=0.0d0
2956 Ug2der(1,1,i-2)=0.0d0
2957 Ug2der(1,2,i-2)=0.0d0
2958 Ug2der(2,1,i-2)=0.0d0
2959 Ug2der(2,2,i-2)=0.0d0
2961 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2962 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2963 iti = itype2loc(itype(i-2))
2967 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2968 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2969 iti1 = itype2loc(itype(i-1))
2973 cd write (iout,*) '*******i',i,' iti1',iti
2974 cd write (iout,*) 'b1',b1(:,iti)
2975 cd write (iout,*) 'b2',b2(:,iti)
2976 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2977 c if (i .gt. iatel_s+2) then
2978 if (i .gt. nnt+2) then
2979 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2981 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2982 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2984 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
2985 c & EE(1,2,iti),EE(2,2,i)
2986 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2987 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2988 c write(iout,*) "Macierz EUG",
2989 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2991 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2993 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2994 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2995 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2996 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2997 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
3008 DtUg2(l,k,i-2)=0.0d0
3012 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
3013 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
3015 muder(k,i-2)=Ub2der(k,i-2)
3017 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3018 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3019 if (itype(i-1).le.ntyp) then
3020 iti1 = itype2loc(itype(i-1))
3028 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
3031 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
3032 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
3033 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
3034 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
3035 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
3036 & ((ee(l,k,i-2),l=1,2),k=1,2),eenew(1,itype2loc(iti))
3038 cd write (iout,*) 'mu1',mu1(:,i-2)
3039 cd write (iout,*) 'mu2',mu2(:,i-2)
3040 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3042 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3043 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
3044 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3045 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
3046 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3047 C Vectors and matrices dependent on a single virtual-bond dihedral.
3048 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
3049 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3050 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3051 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
3052 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
3053 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3054 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3055 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3056 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3059 C Matrices dependent on two consecutive virtual-bond dihedrals.
3060 C The order of matrices is from left to right.
3061 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3063 c do i=max0(ivec_start,2),ivec_end
3065 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3066 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3067 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3068 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3069 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3070 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3071 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3072 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3075 #if defined(MPI) && defined(PARMAT)
3077 c if (fg_rank.eq.0) then
3078 write (iout,*) "Arrays UG and UGDER before GATHER"
3080 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3081 & ((ug(l,k,i),l=1,2),k=1,2),
3082 & ((ugder(l,k,i),l=1,2),k=1,2)
3084 write (iout,*) "Arrays UG2 and UG2DER"
3086 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3087 & ((ug2(l,k,i),l=1,2),k=1,2),
3088 & ((ug2der(l,k,i),l=1,2),k=1,2)
3090 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3092 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3093 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3094 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3096 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3098 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3099 & costab(i),sintab(i),costab2(i),sintab2(i)
3101 write (iout,*) "Array MUDER"
3103 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3107 if (nfgtasks.gt.1) then
3109 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
3110 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
3111 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
3113 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
3114 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3116 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
3117 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3119 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
3120 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3122 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
3123 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3125 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
3126 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3128 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
3129 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3131 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
3132 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
3133 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3134 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
3135 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
3136 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3137 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
3138 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
3139 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3140 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
3141 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
3142 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3143 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3145 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
3146 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3148 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
3149 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3151 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
3152 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3154 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3155 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3157 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3158 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3160 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3161 & ivec_count(fg_rank1),
3162 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3164 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3165 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3167 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3168 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3170 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3171 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3173 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3174 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3176 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3177 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3179 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3180 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3182 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3183 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3185 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3186 & ivec_count(fg_rank1),
3187 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3189 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3190 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3192 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3193 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3195 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3196 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3198 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3199 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3201 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3202 & ivec_count(fg_rank1),
3203 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3205 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3206 & ivec_count(fg_rank1),
3207 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3209 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3210 & ivec_count(fg_rank1),
3211 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3212 & MPI_MAT2,FG_COMM1,IERR)
3213 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3214 & ivec_count(fg_rank1),
3215 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3216 & MPI_MAT2,FG_COMM1,IERR)
3219 c Passes matrix info through the ring
3222 if (irecv.lt.0) irecv=nfgtasks1-1
3225 if (inext.ge.nfgtasks1) inext=0
3227 c write (iout,*) "isend",isend," irecv",irecv
3229 lensend=lentyp(isend)
3230 lenrecv=lentyp(irecv)
3231 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3232 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3233 c & MPI_ROTAT1(lensend),inext,2200+isend,
3234 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3235 c & iprev,2200+irecv,FG_COMM,status,IERR)
3236 c write (iout,*) "Gather ROTAT1"
3238 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3239 c & MPI_ROTAT2(lensend),inext,3300+isend,
3240 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3241 c & iprev,3300+irecv,FG_COMM,status,IERR)
3242 c write (iout,*) "Gather ROTAT2"
3244 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3245 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3246 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3247 & iprev,4400+irecv,FG_COMM,status,IERR)
3248 c write (iout,*) "Gather ROTAT_OLD"
3250 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3251 & MPI_PRECOMP11(lensend),inext,5500+isend,
3252 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3253 & iprev,5500+irecv,FG_COMM,status,IERR)
3254 c write (iout,*) "Gather PRECOMP11"
3256 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3257 & MPI_PRECOMP12(lensend),inext,6600+isend,
3258 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3259 & iprev,6600+irecv,FG_COMM,status,IERR)
3260 c write (iout,*) "Gather PRECOMP12"
3262 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3264 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3265 & MPI_ROTAT2(lensend),inext,7700+isend,
3266 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3267 & iprev,7700+irecv,FG_COMM,status,IERR)
3268 c write (iout,*) "Gather PRECOMP21"
3270 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3271 & MPI_PRECOMP22(lensend),inext,8800+isend,
3272 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3273 & iprev,8800+irecv,FG_COMM,status,IERR)
3274 c write (iout,*) "Gather PRECOMP22"
3276 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3277 & MPI_PRECOMP23(lensend),inext,9900+isend,
3278 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3279 & MPI_PRECOMP23(lenrecv),
3280 & iprev,9900+irecv,FG_COMM,status,IERR)
3281 c write (iout,*) "Gather PRECOMP23"
3286 if (irecv.lt.0) irecv=nfgtasks1-1
3289 time_gather=time_gather+MPI_Wtime()-time00
3292 c if (fg_rank.eq.0) then
3293 write (iout,*) "Arrays UG and UGDER"
3295 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3296 & ((ug(l,k,i),l=1,2),k=1,2),
3297 & ((ugder(l,k,i),l=1,2),k=1,2)
3299 write (iout,*) "Arrays UG2 and UG2DER"
3301 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3302 & ((ug2(l,k,i),l=1,2),k=1,2),
3303 & ((ug2der(l,k,i),l=1,2),k=1,2)
3305 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3307 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3308 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3309 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3311 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3313 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3314 & costab(i),sintab(i),costab2(i),sintab2(i)
3316 write (iout,*) "Array MUDER"
3318 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3324 cd iti = itype2loc(itype(i))
3327 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3328 cd & (EE(j,k,i),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3333 C--------------------------------------------------------------------------
3334 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3336 C This subroutine calculates the average interaction energy and its gradient
3337 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3338 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3339 C The potential depends both on the distance of peptide-group centers and on
3340 C the orientation of the CA-CA virtual bonds.
3342 implicit real*8 (a-h,o-z)
3346 include 'DIMENSIONS'
3347 include 'COMMON.CONTROL'
3348 include 'COMMON.SETUP'
3349 include 'COMMON.IOUNITS'
3350 include 'COMMON.GEO'
3351 include 'COMMON.VAR'
3352 include 'COMMON.LOCAL'
3353 include 'COMMON.CHAIN'
3354 include 'COMMON.DERIV'
3355 include 'COMMON.INTERACT'
3356 include 'COMMON.CONTACTS'
3357 include 'COMMON.TORSION'
3358 include 'COMMON.VECTORS'
3359 include 'COMMON.FFIELD'
3360 include 'COMMON.TIME1'
3361 include 'COMMON.SPLITELE'
3362 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3363 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3364 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3365 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3366 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3367 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3369 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3371 double precision scal_el /1.0d0/
3373 double precision scal_el /0.5d0/
3376 C 13-go grudnia roku pamietnego...
3377 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3378 & 0.0d0,1.0d0,0.0d0,
3379 & 0.0d0,0.0d0,1.0d0/
3380 cd write(iout,*) 'In EELEC'
3382 cd write(iout,*) 'Type',i
3383 cd write(iout,*) 'B1',B1(:,i)
3384 cd write(iout,*) 'B2',B2(:,i)
3385 cd write(iout,*) 'CC',CC(:,:,i)
3386 cd write(iout,*) 'DD',DD(:,:,i)
3387 cd write(iout,*) 'EE',EE(:,:,i)
3389 cd call check_vecgrad
3391 if (icheckgrad.eq.1) then
3393 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3395 dc_norm(k,i)=dc(k,i)*fac
3397 c write (iout,*) 'i',i,' fac',fac
3400 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3401 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3402 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3403 c call vec_and_deriv
3409 time_mat=time_mat+MPI_Wtime()-time01
3413 cd write (iout,*) 'i=',i
3415 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3418 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3419 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3432 cd print '(a)','Enter EELEC'
3433 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3435 gel_loc_loc(i)=0.0d0
3440 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3442 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3444 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3445 do i=iturn3_start,iturn3_end
3447 C write(iout,*) "tu jest i",i
3448 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3449 C changes suggested by Ana to avoid out of bounds
3450 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
3451 c & .or.((i+4).gt.nres)
3452 c & .or.((i-1).le.0)
3453 C end of changes by Ana
3454 & .or. itype(i+2).eq.ntyp1
3455 & .or. itype(i+3).eq.ntyp1) cycle
3456 C Adam: Instructions below will switch off existing interactions
3458 c if(itype(i-1).eq.ntyp1)cycle
3460 c if(i.LT.nres-3)then
3461 c if (itype(i+4).eq.ntyp1) cycle
3466 dx_normi=dc_norm(1,i)
3467 dy_normi=dc_norm(2,i)
3468 dz_normi=dc_norm(3,i)
3469 xmedi=c(1,i)+0.5d0*dxi
3470 ymedi=c(2,i)+0.5d0*dyi
3471 zmedi=c(3,i)+0.5d0*dzi
3472 xmedi=mod(xmedi,boxxsize)
3473 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3474 ymedi=mod(ymedi,boxysize)
3475 if (ymedi.lt.0) ymedi=ymedi+boxysize
3476 zmedi=mod(zmedi,boxzsize)
3477 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3479 call eelecij(i,i+2,ees,evdw1,eel_loc)
3480 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3481 num_cont_hb(i)=num_conti
3483 do i=iturn4_start,iturn4_end
3485 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3486 C changes suggested by Ana to avoid out of bounds
3487 c & .or.((i+5).gt.nres)
3488 c & .or.((i-1).le.0)
3489 C end of changes suggested by Ana
3490 & .or. itype(i+3).eq.ntyp1
3491 & .or. itype(i+4).eq.ntyp1
3492 c & .or. itype(i+5).eq.ntyp1
3493 c & .or. itype(i).eq.ntyp1
3494 c & .or. itype(i-1).eq.ntyp1
3499 dx_normi=dc_norm(1,i)
3500 dy_normi=dc_norm(2,i)
3501 dz_normi=dc_norm(3,i)
3502 xmedi=c(1,i)+0.5d0*dxi
3503 ymedi=c(2,i)+0.5d0*dyi
3504 zmedi=c(3,i)+0.5d0*dzi
3505 C Return atom into box, boxxsize is size of box in x dimension
3507 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3508 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3509 C Condition for being inside the proper box
3510 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3511 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3515 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3516 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3517 C Condition for being inside the proper box
3518 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3519 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3523 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3524 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3525 C Condition for being inside the proper box
3526 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3527 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3530 xmedi=mod(xmedi,boxxsize)
3531 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3532 ymedi=mod(ymedi,boxysize)
3533 if (ymedi.lt.0) ymedi=ymedi+boxysize
3534 zmedi=mod(zmedi,boxzsize)
3535 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3537 num_conti=num_cont_hb(i)
3538 c write(iout,*) "JESTEM W PETLI"
3539 call eelecij(i,i+3,ees,evdw1,eel_loc)
3540 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3541 & call eturn4(i,eello_turn4)
3542 num_cont_hb(i)=num_conti
3544 C Loop over all neighbouring boxes
3549 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3552 do i=iatel_s,iatel_e
3555 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3556 C changes suggested by Ana to avoid out of bounds
3557 c & .or.((i+2).gt.nres)
3558 c & .or.((i-1).le.0)
3559 C end of changes by Ana
3560 c & .or. itype(i+2).eq.ntyp1
3561 c & .or. itype(i-1).eq.ntyp1
3566 dx_normi=dc_norm(1,i)
3567 dy_normi=dc_norm(2,i)
3568 dz_normi=dc_norm(3,i)
3569 xmedi=c(1,i)+0.5d0*dxi
3570 ymedi=c(2,i)+0.5d0*dyi
3571 zmedi=c(3,i)+0.5d0*dzi
3572 xmedi=mod(xmedi,boxxsize)
3573 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3574 ymedi=mod(ymedi,boxysize)
3575 if (ymedi.lt.0) ymedi=ymedi+boxysize
3576 zmedi=mod(zmedi,boxzsize)
3577 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3578 C xmedi=xmedi+xshift*boxxsize
3579 C ymedi=ymedi+yshift*boxysize
3580 C zmedi=zmedi+zshift*boxzsize
3582 C Return tom into box, boxxsize is size of box in x dimension
3584 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3585 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3586 C Condition for being inside the proper box
3587 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3588 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3592 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3593 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3594 C Condition for being inside the proper box
3595 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3596 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3600 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3601 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3602 cC Condition for being inside the proper box
3603 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3604 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3608 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3609 num_conti=num_cont_hb(i)
3611 do j=ielstart(i),ielend(i)
3613 C write (iout,*) i,j
3615 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3616 C changes suggested by Ana to avoid out of bounds
3617 c & .or.((j+2).gt.nres)
3618 c & .or.((j-1).le.0)
3619 C end of changes by Ana
3620 c & .or.itype(j+2).eq.ntyp1
3621 c & .or.itype(j-1).eq.ntyp1
3623 call eelecij(i,j,ees,evdw1,eel_loc)
3625 num_cont_hb(i)=num_conti
3631 c write (iout,*) "Number of loop steps in EELEC:",ind
3633 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3634 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3636 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3637 ccc eel_loc=eel_loc+eello_turn3
3638 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3641 C-------------------------------------------------------------------------------
3642 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3643 implicit real*8 (a-h,o-z)
3644 include 'DIMENSIONS'
3648 include 'COMMON.CONTROL'
3649 include 'COMMON.IOUNITS'
3650 include 'COMMON.GEO'
3651 include 'COMMON.VAR'
3652 include 'COMMON.LOCAL'
3653 include 'COMMON.CHAIN'
3654 include 'COMMON.DERIV'
3655 include 'COMMON.INTERACT'
3656 include 'COMMON.CONTACTS'
3657 include 'COMMON.TORSION'
3658 include 'COMMON.VECTORS'
3659 include 'COMMON.FFIELD'
3660 include 'COMMON.TIME1'
3661 include 'COMMON.SPLITELE'
3662 include 'COMMON.SHIELD'
3663 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3664 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3665 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3666 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3667 & gmuij2(4),gmuji2(4)
3668 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3669 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3671 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3673 double precision scal_el /1.0d0/
3675 double precision scal_el /0.5d0/
3678 C 13-go grudnia roku pamietnego...
3679 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3680 & 0.0d0,1.0d0,0.0d0,
3681 & 0.0d0,0.0d0,1.0d0/
3682 integer xshift,yshift,zshift
3683 c time00=MPI_Wtime()
3684 cd write (iout,*) "eelecij",i,j
3688 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3689 aaa=app(iteli,itelj)
3690 bbb=bpp(iteli,itelj)
3691 ael6i=ael6(iteli,itelj)
3692 ael3i=ael3(iteli,itelj)
3696 dx_normj=dc_norm(1,j)
3697 dy_normj=dc_norm(2,j)
3698 dz_normj=dc_norm(3,j)
3699 C xj=c(1,j)+0.5D0*dxj-xmedi
3700 C yj=c(2,j)+0.5D0*dyj-ymedi
3701 C zj=c(3,j)+0.5D0*dzj-zmedi
3706 if (xj.lt.0) xj=xj+boxxsize
3708 if (yj.lt.0) yj=yj+boxysize
3710 if (zj.lt.0) zj=zj+boxzsize
3711 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3712 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3720 xj=xj_safe+xshift*boxxsize
3721 yj=yj_safe+yshift*boxysize
3722 zj=zj_safe+zshift*boxzsize
3723 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3724 if(dist_temp.lt.dist_init) then
3734 if (isubchap.eq.1) then
3743 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3745 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3746 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3747 C Condition for being inside the proper box
3748 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3749 c & (xj.lt.((-0.5d0)*boxxsize))) then
3753 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3754 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3755 C Condition for being inside the proper box
3756 c if ((yj.gt.((0.5d0)*boxysize)).or.
3757 c & (yj.lt.((-0.5d0)*boxysize))) then
3761 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3762 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3763 C Condition for being inside the proper box
3764 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3765 c & (zj.lt.((-0.5d0)*boxzsize))) then
3768 C endif !endPBC condintion
3772 rij=xj*xj+yj*yj+zj*zj
3774 sss=sscale(sqrt(rij))
3775 sssgrad=sscagrad(sqrt(rij))
3776 c if (sss.gt.0.0d0) then
3782 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3783 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3784 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3785 fac=cosa-3.0D0*cosb*cosg
3787 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3788 if (j.eq.i+2) ev1=scal_el*ev1
3793 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3797 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3798 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3799 if (shield_mode.gt.0) then
3802 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3803 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3812 evdw1=evdw1+evdwij*sss
3813 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3814 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3815 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3816 cd & xmedi,ymedi,zmedi,xj,yj,zj
3818 if (energy_dec) then
3819 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3821 &,iteli,itelj,aaa,evdw1
3823 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
3824 &fac_shield(i),fac_shield(j)
3828 C Calculate contributions to the Cartesian gradient.
3831 facvdw=-6*rrmij*(ev1+evdwij)*sss
3832 facel=-3*rrmij*(el1+eesij)
3839 * Radial derivatives. First process both termini of the fragment (i,j)
3844 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3845 & (shield_mode.gt.0)) then
3847 do ilist=1,ishield_list(i)
3848 iresshield=shield_list(ilist,i)
3850 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
3852 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3854 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
3855 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3856 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3857 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3858 C if (iresshield.gt.i) then
3859 C do ishi=i+1,iresshield-1
3860 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3861 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3865 C do ishi=iresshield,i
3866 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3867 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3873 do ilist=1,ishield_list(j)
3874 iresshield=shield_list(ilist,j)
3876 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
3878 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3880 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
3881 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3883 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3884 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3885 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3886 C if (iresshield.gt.j) then
3887 C do ishi=j+1,iresshield-1
3888 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
3889 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3893 C do ishi=iresshield,j
3894 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
3895 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
3902 gshieldc(k,i)=gshieldc(k,i)+
3903 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
3904 gshieldc(k,j)=gshieldc(k,j)+
3905 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
3906 gshieldc(k,i-1)=gshieldc(k,i-1)+
3907 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
3908 gshieldc(k,j-1)=gshieldc(k,j-1)+
3909 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
3914 c ghalf=0.5D0*ggg(k)
3915 c gelc(k,i)=gelc(k,i)+ghalf
3916 c gelc(k,j)=gelc(k,j)+ghalf
3918 c 9/28/08 AL Gradient compotents will be summed only at the end
3919 C print *,"before", gelc_long(1,i), gelc_long(1,j)
3921 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3922 C & +grad_shield(k,j)*eesij/fac_shield(j)
3923 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3924 C & +grad_shield(k,i)*eesij/fac_shield(i)
3925 C gelc_long(k,i-1)=gelc_long(k,i-1)
3926 C & +grad_shield(k,i)*eesij/fac_shield(i)
3927 C gelc_long(k,j-1)=gelc_long(k,j-1)
3928 C & +grad_shield(k,j)*eesij/fac_shield(j)
3930 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
3933 * Loop over residues i+1 thru j-1.
3937 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3940 if (sss.gt.0.0) then
3941 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3942 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3943 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3950 c ghalf=0.5D0*ggg(k)
3951 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3952 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3954 c 9/28/08 AL Gradient compotents will be summed only at the end
3956 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3957 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3960 * Loop over residues i+1 thru j-1.
3964 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3969 facvdw=(ev1+evdwij)*sss
3972 fac=-3*rrmij*(facvdw+facvdw+facel)
3977 * Radial derivatives. First process both termini of the fragment (i,j)
3980 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
3982 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
3984 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
3986 c ghalf=0.5D0*ggg(k)
3987 c gelc(k,i)=gelc(k,i)+ghalf
3988 c gelc(k,j)=gelc(k,j)+ghalf
3990 c 9/28/08 AL Gradient compotents will be summed only at the end
3992 gelc_long(k,j)=gelc(k,j)+ggg(k)
3993 gelc_long(k,i)=gelc(k,i)-ggg(k)
3996 * Loop over residues i+1 thru j-1.
4000 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4003 c 9/28/08 AL Gradient compotents will be summed only at the end
4004 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
4005 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
4006 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
4008 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4009 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4015 ecosa=2.0D0*fac3*fac1+fac4
4018 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
4019 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
4021 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4022 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4024 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
4025 cd & (dcosg(k),k=1,3)
4027 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
4028 & fac_shield(i)**2*fac_shield(j)**2
4031 c ghalf=0.5D0*ggg(k)
4032 c gelc(k,i)=gelc(k,i)+ghalf
4033 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4034 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4035 c gelc(k,j)=gelc(k,j)+ghalf
4036 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4037 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4041 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4044 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
4047 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4048 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
4049 & *fac_shield(i)**2*fac_shield(j)**2
4051 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4052 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
4053 & *fac_shield(i)**2*fac_shield(j)**2
4054 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4055 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4057 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
4061 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
4062 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
4063 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4065 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
4066 C energy of a peptide unit is assumed in the form of a second-order
4067 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
4068 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
4069 C are computed for EVERY pair of non-contiguous peptide groups.
4072 if (j.lt.nres-1) then
4084 muij(kkk)=mu(k,i)*mu(l,j)
4085 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
4087 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
4088 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
4089 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
4090 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
4091 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
4092 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4096 cd write (iout,*) 'EELEC: i',i,' j',j
4097 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
4098 cd write(iout,*) 'muij',muij
4099 ury=scalar(uy(1,i),erij)
4100 urz=scalar(uz(1,i),erij)
4101 vry=scalar(uy(1,j),erij)
4102 vrz=scalar(uz(1,j),erij)
4103 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4104 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4105 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4106 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4107 fac=dsqrt(-ael6i)*r3ij
4112 cd write (iout,'(4i5,4f10.5)')
4113 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
4114 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4115 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4116 cd & uy(:,j),uz(:,j)
4117 cd write (iout,'(4f10.5)')
4118 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4119 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4120 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
4121 cd write (iout,'(9f10.5/)')
4122 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4123 C Derivatives of the elements of A in virtual-bond vectors
4124 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4126 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4127 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4128 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4129 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4130 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4131 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4132 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4133 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4134 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4135 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4136 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4137 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4139 C Compute radial contributions to the gradient
4157 C Add the contributions coming from er
4160 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4161 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4162 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4163 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4166 C Derivatives in DC(i)
4167 cgrad ghalf1=0.5d0*agg(k,1)
4168 cgrad ghalf2=0.5d0*agg(k,2)
4169 cgrad ghalf3=0.5d0*agg(k,3)
4170 cgrad ghalf4=0.5d0*agg(k,4)
4171 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
4172 & -3.0d0*uryg(k,2)*vry)!+ghalf1
4173 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
4174 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
4175 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
4176 & -3.0d0*urzg(k,2)*vry)!+ghalf3
4177 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
4178 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
4179 C Derivatives in DC(i+1)
4180 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
4181 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4182 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
4183 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4184 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
4185 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4186 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
4187 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4188 C Derivatives in DC(j)
4189 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
4190 & -3.0d0*vryg(k,2)*ury)!+ghalf1
4191 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4192 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4193 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4194 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4195 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4196 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4197 C Derivatives in DC(j+1) or DC(nres-1)
4198 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4199 & -3.0d0*vryg(k,3)*ury)
4200 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4201 & -3.0d0*vrzg(k,3)*ury)
4202 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4203 & -3.0d0*vryg(k,3)*urz)
4204 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4205 & -3.0d0*vrzg(k,3)*urz)
4206 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4208 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4221 aggi(k,l)=-aggi(k,l)
4222 aggi1(k,l)=-aggi1(k,l)
4223 aggj(k,l)=-aggj(k,l)
4224 aggj1(k,l)=-aggj1(k,l)
4227 if (j.lt.nres-1) then
4233 aggi(k,l)=-aggi(k,l)
4234 aggi1(k,l)=-aggi1(k,l)
4235 aggj(k,l)=-aggj(k,l)
4236 aggj1(k,l)=-aggj1(k,l)
4247 aggi(k,l)=-aggi(k,l)
4248 aggi1(k,l)=-aggi1(k,l)
4249 aggj(k,l)=-aggj(k,l)
4250 aggj1(k,l)=-aggj1(k,l)
4255 IF (wel_loc.gt.0.0d0) THEN
4256 C Contribution to the local-electrostatic energy coming from the i-j pair
4257 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4259 if (shield_mode.eq.0) then
4266 eel_loc_ij=eel_loc_ij
4267 & *fac_shield(i)*fac_shield(j)
4268 C Now derivative over eel_loc
4269 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4270 & (shield_mode.gt.0)) then
4273 do ilist=1,ishield_list(i)
4274 iresshield=shield_list(ilist,i)
4276 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
4279 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4281 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
4282 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4286 do ilist=1,ishield_list(j)
4287 iresshield=shield_list(ilist,j)
4289 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
4292 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4294 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
4295 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4302 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
4303 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4304 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
4305 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4306 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
4307 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4308 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
4309 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4314 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4315 c & ' eel_loc_ij',eel_loc_ij
4316 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4317 C Calculate patrial derivative for theta angle
4319 geel_loc_ij=(a22*gmuij1(1)
4323 & *fac_shield(i)*fac_shield(j)
4324 c write(iout,*) "derivative over thatai"
4325 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4327 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4328 & geel_loc_ij*wel_loc
4329 c write(iout,*) "derivative over thatai-1"
4330 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4337 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4338 & geel_loc_ij*wel_loc
4339 & *fac_shield(i)*fac_shield(j)
4341 c Derivative over j residue
4342 geel_loc_ji=a22*gmuji1(1)
4346 c write(iout,*) "derivative over thataj"
4347 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4350 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4351 & geel_loc_ji*wel_loc
4352 & *fac_shield(i)*fac_shield(j)
4359 c write(iout,*) "derivative over thataj-1"
4360 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4362 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4363 & geel_loc_ji*wel_loc
4364 & *fac_shield(i)*fac_shield(j)
4366 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4368 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4369 & 'eelloc',i,j,eel_loc_ij
4370 c if (eel_loc_ij.ne.0)
4371 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4372 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4374 eel_loc=eel_loc+eel_loc_ij
4375 C Partial derivatives in virtual-bond dihedral angles gamma
4377 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4378 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4379 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
4380 & *fac_shield(i)*fac_shield(j)
4382 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4383 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4384 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
4385 & *fac_shield(i)*fac_shield(j)
4386 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4388 ggg(l)=(agg(l,1)*muij(1)+
4389 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
4390 & *fac_shield(i)*fac_shield(j)
4391 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4392 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4393 cgrad ghalf=0.5d0*ggg(l)
4394 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4395 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4399 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4402 C Remaining derivatives of eello
4404 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4405 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4406 & *fac_shield(i)*fac_shield(j)
4408 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4409 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4410 & *fac_shield(i)*fac_shield(j)
4412 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4413 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4414 & *fac_shield(i)*fac_shield(j)
4416 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4417 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4418 & *fac_shield(i)*fac_shield(j)
4422 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4423 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4424 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4425 & .and. num_conti.le.maxconts) then
4426 c write (iout,*) i,j," entered corr"
4428 C Calculate the contact function. The ith column of the array JCONT will
4429 C contain the numbers of atoms that make contacts with the atom I (of numbers
4430 C greater than I). The arrays FACONT and GACONT will contain the values of
4431 C the contact function and its derivative.
4432 c r0ij=1.02D0*rpp(iteli,itelj)
4433 c r0ij=1.11D0*rpp(iteli,itelj)
4434 r0ij=2.20D0*rpp(iteli,itelj)
4435 c r0ij=1.55D0*rpp(iteli,itelj)
4436 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4437 if (fcont.gt.0.0D0) then
4438 num_conti=num_conti+1
4439 if (num_conti.gt.maxconts) then
4440 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4441 & ' will skip next contacts for this conf.'
4443 jcont_hb(num_conti,i)=j
4444 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4445 cd & " jcont_hb",jcont_hb(num_conti,i)
4446 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4447 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4448 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4450 d_cont(num_conti,i)=rij
4451 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4452 C --- Electrostatic-interaction matrix ---
4453 a_chuj(1,1,num_conti,i)=a22
4454 a_chuj(1,2,num_conti,i)=a23
4455 a_chuj(2,1,num_conti,i)=a32
4456 a_chuj(2,2,num_conti,i)=a33
4457 C --- Gradient of rij
4459 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4466 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4467 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4468 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4469 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4470 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4475 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4476 C Calculate contact energies
4478 wij=cosa-3.0D0*cosb*cosg
4481 c fac3=dsqrt(-ael6i)/r0ij**3
4482 fac3=dsqrt(-ael6i)*r3ij
4483 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4484 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4485 if (ees0tmp.gt.0) then
4486 ees0pij=dsqrt(ees0tmp)
4490 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4491 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4492 if (ees0tmp.gt.0) then
4493 ees0mij=dsqrt(ees0tmp)
4498 if (shield_mode.eq.0) then
4502 ees0plist(num_conti,i)=j
4503 C fac_shield(i)=0.4d0
4504 C fac_shield(j)=0.6d0
4506 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4507 & *fac_shield(i)*fac_shield(j)
4508 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4509 & *fac_shield(i)*fac_shield(j)
4510 C Diagnostics. Comment out or remove after debugging!
4511 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4512 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4513 c ees0m(num_conti,i)=0.0D0
4515 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4516 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4517 C Angular derivatives of the contact function
4518 ees0pij1=fac3/ees0pij
4519 ees0mij1=fac3/ees0mij
4520 fac3p=-3.0D0*fac3*rrmij
4521 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4522 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4524 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4525 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4526 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4527 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4528 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4529 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4530 ecosap=ecosa1+ecosa2
4531 ecosbp=ecosb1+ecosb2
4532 ecosgp=ecosg1+ecosg2
4533 ecosam=ecosa1-ecosa2
4534 ecosbm=ecosb1-ecosb2
4535 ecosgm=ecosg1-ecosg2
4544 facont_hb(num_conti,i)=fcont
4545 fprimcont=fprimcont/rij
4546 cd facont_hb(num_conti,i)=1.0D0
4547 C Following line is for diagnostics.
4550 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4551 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4554 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4555 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4557 gggp(1)=gggp(1)+ees0pijp*xj
4558 gggp(2)=gggp(2)+ees0pijp*yj
4559 gggp(3)=gggp(3)+ees0pijp*zj
4560 gggm(1)=gggm(1)+ees0mijp*xj
4561 gggm(2)=gggm(2)+ees0mijp*yj
4562 gggm(3)=gggm(3)+ees0mijp*zj
4563 C Derivatives due to the contact function
4564 gacont_hbr(1,num_conti,i)=fprimcont*xj
4565 gacont_hbr(2,num_conti,i)=fprimcont*yj
4566 gacont_hbr(3,num_conti,i)=fprimcont*zj
4569 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4570 c following the change of gradient-summation algorithm.
4572 cgrad ghalfp=0.5D0*gggp(k)
4573 cgrad ghalfm=0.5D0*gggm(k)
4574 gacontp_hb1(k,num_conti,i)=!ghalfp
4575 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4576 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4577 & *fac_shield(i)*fac_shield(j)
4579 gacontp_hb2(k,num_conti,i)=!ghalfp
4580 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4581 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4582 & *fac_shield(i)*fac_shield(j)
4584 gacontp_hb3(k,num_conti,i)=gggp(k)
4585 & *fac_shield(i)*fac_shield(j)
4587 gacontm_hb1(k,num_conti,i)=!ghalfm
4588 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4589 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4590 & *fac_shield(i)*fac_shield(j)
4592 gacontm_hb2(k,num_conti,i)=!ghalfm
4593 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4594 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4595 & *fac_shield(i)*fac_shield(j)
4597 gacontm_hb3(k,num_conti,i)=gggm(k)
4598 & *fac_shield(i)*fac_shield(j)
4601 C Diagnostics. Comment out or remove after debugging!
4603 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4604 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4605 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4606 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4607 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4608 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4611 endif ! num_conti.le.maxconts
4614 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4617 ghalf=0.5d0*agg(l,k)
4618 aggi(l,k)=aggi(l,k)+ghalf
4619 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4620 aggj(l,k)=aggj(l,k)+ghalf
4623 if (j.eq.nres-1 .and. i.lt.j-2) then
4626 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4631 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4634 C-----------------------------------------------------------------------------
4635 subroutine eturn3(i,eello_turn3)
4636 C Third- and fourth-order contributions from turns
4637 implicit real*8 (a-h,o-z)
4638 include 'DIMENSIONS'
4639 include 'COMMON.IOUNITS'
4640 include 'COMMON.GEO'
4641 include 'COMMON.VAR'
4642 include 'COMMON.LOCAL'
4643 include 'COMMON.CHAIN'
4644 include 'COMMON.DERIV'
4645 include 'COMMON.INTERACT'
4646 include 'COMMON.CONTACTS'
4647 include 'COMMON.TORSION'
4648 include 'COMMON.VECTORS'
4649 include 'COMMON.FFIELD'
4650 include 'COMMON.CONTROL'
4651 include 'COMMON.SHIELD'
4653 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4654 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4655 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4656 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4657 & auxgmat2(2,2),auxgmatt2(2,2)
4658 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4659 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4660 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4661 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4664 c write (iout,*) "eturn3",i,j,j1,j2
4669 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4671 C Third-order contributions
4678 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4679 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4680 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4681 c auxalary matices for theta gradient
4682 c auxalary matrix for i+1 and constant i+2
4683 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4684 c auxalary matrix for i+2 and constant i+1
4685 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4686 call transpose2(auxmat(1,1),auxmat1(1,1))
4687 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4688 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4689 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4690 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4691 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4692 if (shield_mode.eq.0) then
4699 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4700 & *fac_shield(i)*fac_shield(j)
4701 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
4702 & *fac_shield(i)*fac_shield(j)
4704 C Derivatives in theta
4705 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4706 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4707 & *fac_shield(i)*fac_shield(j)
4708 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4709 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4710 & *fac_shield(i)*fac_shield(j)
4713 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4714 C Derivatives in shield mode
4715 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4716 & (shield_mode.gt.0)) then
4719 do ilist=1,ishield_list(i)
4720 iresshield=shield_list(ilist,i)
4722 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4724 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4726 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4727 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4731 do ilist=1,ishield_list(j)
4732 iresshield=shield_list(ilist,j)
4734 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4736 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4738 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4739 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4746 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
4747 & grad_shield(k,i)*eello_t3/fac_shield(i)
4748 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
4749 & grad_shield(k,j)*eello_t3/fac_shield(j)
4750 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
4751 & grad_shield(k,i)*eello_t3/fac_shield(i)
4752 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
4753 & grad_shield(k,j)*eello_t3/fac_shield(j)
4757 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4758 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4759 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4760 cd & ' eello_turn3_num',4*eello_turn3_num
4761 C Derivatives in gamma(i)
4762 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4763 call transpose2(auxmat2(1,1),auxmat3(1,1))
4764 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4765 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4766 & *fac_shield(i)*fac_shield(j)
4767 C Derivatives in gamma(i+1)
4768 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4769 call transpose2(auxmat2(1,1),auxmat3(1,1))
4770 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4771 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4772 & +0.5d0*(pizda(1,1)+pizda(2,2))
4773 & *fac_shield(i)*fac_shield(j)
4774 C Cartesian derivatives
4776 c ghalf1=0.5d0*agg(l,1)
4777 c ghalf2=0.5d0*agg(l,2)
4778 c ghalf3=0.5d0*agg(l,3)
4779 c ghalf4=0.5d0*agg(l,4)
4780 a_temp(1,1)=aggi(l,1)!+ghalf1
4781 a_temp(1,2)=aggi(l,2)!+ghalf2
4782 a_temp(2,1)=aggi(l,3)!+ghalf3
4783 a_temp(2,2)=aggi(l,4)!+ghalf4
4784 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4785 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4786 & +0.5d0*(pizda(1,1)+pizda(2,2))
4787 & *fac_shield(i)*fac_shield(j)
4789 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4790 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4791 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4792 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4793 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4794 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4795 & +0.5d0*(pizda(1,1)+pizda(2,2))
4796 & *fac_shield(i)*fac_shield(j)
4797 a_temp(1,1)=aggj(l,1)!+ghalf1
4798 a_temp(1,2)=aggj(l,2)!+ghalf2
4799 a_temp(2,1)=aggj(l,3)!+ghalf3
4800 a_temp(2,2)=aggj(l,4)!+ghalf4
4801 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4802 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4803 & +0.5d0*(pizda(1,1)+pizda(2,2))
4804 & *fac_shield(i)*fac_shield(j)
4805 a_temp(1,1)=aggj1(l,1)
4806 a_temp(1,2)=aggj1(l,2)
4807 a_temp(2,1)=aggj1(l,3)
4808 a_temp(2,2)=aggj1(l,4)
4809 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4810 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4811 & +0.5d0*(pizda(1,1)+pizda(2,2))
4812 & *fac_shield(i)*fac_shield(j)
4816 C-------------------------------------------------------------------------------
4817 subroutine eturn4(i,eello_turn4)
4818 C Third- and fourth-order contributions from turns
4819 implicit real*8 (a-h,o-z)
4820 include 'DIMENSIONS'
4821 include 'COMMON.IOUNITS'
4822 include 'COMMON.GEO'
4823 include 'COMMON.VAR'
4824 include 'COMMON.LOCAL'
4825 include 'COMMON.CHAIN'
4826 include 'COMMON.DERIV'
4827 include 'COMMON.INTERACT'
4828 include 'COMMON.CONTACTS'
4829 include 'COMMON.TORSION'
4830 include 'COMMON.VECTORS'
4831 include 'COMMON.FFIELD'
4832 include 'COMMON.CONTROL'
4833 include 'COMMON.SHIELD'
4835 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4836 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4837 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4838 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4839 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4840 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4841 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4842 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4843 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4844 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4845 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4848 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4850 C Fourth-order contributions
4858 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4859 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4860 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4861 c write(iout,*)"WCHODZE W PROGRAM"
4866 iti1=itype2loc(itype(i+1))
4867 iti2=itype2loc(itype(i+2))
4868 iti3=itype2loc(itype(i+3))
4869 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4870 call transpose2(EUg(1,1,i+1),e1t(1,1))
4871 call transpose2(Eug(1,1,i+2),e2t(1,1))
4872 call transpose2(Eug(1,1,i+3),e3t(1,1))
4873 C Ematrix derivative in theta
4874 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4875 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4876 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4877 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4878 c eta1 in derivative theta
4879 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4880 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4881 c auxgvec is derivative of Ub2 so i+3 theta
4882 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4883 c auxalary matrix of E i+1
4884 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4887 s1=scalar2(b1(1,i+2),auxvec(1))
4888 c derivative of theta i+2 with constant i+3
4889 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4890 c derivative of theta i+2 with constant i+2
4891 gs32=scalar2(b1(1,i+2),auxgvec(1))
4892 c derivative of E matix in theta of i+1
4893 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4895 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4896 c ea31 in derivative theta
4897 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4898 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4899 c auxilary matrix auxgvec of Ub2 with constant E matirx
4900 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4901 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4902 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4906 s2=scalar2(b1(1,i+1),auxvec(1))
4907 c derivative of theta i+1 with constant i+3
4908 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4909 c derivative of theta i+2 with constant i+1
4910 gs21=scalar2(b1(1,i+1),auxgvec(1))
4911 c derivative of theta i+3 with constant i+1
4912 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4913 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4915 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4916 c two derivatives over diffetent matrices
4917 c gtae3e2 is derivative over i+3
4918 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4919 c ae3gte2 is derivative over i+2
4920 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4921 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4922 c three possible derivative over theta E matices
4924 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4926 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4928 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4929 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4931 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4932 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4933 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4934 if (shield_mode.eq.0) then
4941 eello_turn4=eello_turn4-(s1+s2+s3)
4942 & *fac_shield(i)*fac_shield(j)
4943 eello_t4=-(s1+s2+s3)
4944 & *fac_shield(i)*fac_shield(j)
4945 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4946 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4947 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4948 C Now derivative over shield:
4949 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4950 & (shield_mode.gt.0)) then
4953 do ilist=1,ishield_list(i)
4954 iresshield=shield_list(ilist,i)
4956 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
4958 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
4960 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
4961 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
4965 do ilist=1,ishield_list(j)
4966 iresshield=shield_list(ilist,j)
4968 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
4970 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
4972 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
4973 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
4980 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
4981 & grad_shield(k,i)*eello_t4/fac_shield(i)
4982 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
4983 & grad_shield(k,j)*eello_t4/fac_shield(j)
4984 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
4985 & grad_shield(k,i)*eello_t4/fac_shield(i)
4986 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
4987 & grad_shield(k,j)*eello_t4/fac_shield(j)
4996 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4997 cd & ' eello_turn4_num',8*eello_turn4_num
4999 gloc(nphi+i,icg)=gloc(nphi+i,icg)
5000 & -(gs13+gsE13+gsEE1)*wturn4
5001 & *fac_shield(i)*fac_shield(j)
5002 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
5003 & -(gs23+gs21+gsEE2)*wturn4
5004 & *fac_shield(i)*fac_shield(j)
5006 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
5007 & -(gs32+gsE31+gsEE3)*wturn4
5008 & *fac_shield(i)*fac_shield(j)
5010 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
5013 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5014 & 'eturn4',i,j,-(s1+s2+s3)
5015 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5016 c & ' eello_turn4_num',8*eello_turn4_num
5017 C Derivatives in gamma(i)
5018 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
5019 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
5020 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
5021 s1=scalar2(b1(1,i+2),auxvec(1))
5022 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
5023 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5024 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
5025 & *fac_shield(i)*fac_shield(j)
5026 C Derivatives in gamma(i+1)
5027 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
5028 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
5029 s2=scalar2(b1(1,i+1),auxvec(1))
5030 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5031 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5032 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5033 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
5034 & *fac_shield(i)*fac_shield(j)
5035 C Derivatives in gamma(i+2)
5036 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5037 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5038 s1=scalar2(b1(1,i+2),auxvec(1))
5039 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5040 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5041 s2=scalar2(b1(1,i+1),auxvec(1))
5042 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5043 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5044 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5045 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
5046 & *fac_shield(i)*fac_shield(j)
5047 C Cartesian derivatives
5048 C Derivatives of this turn contributions in DC(i+2)
5049 if (j.lt.nres-1) then
5051 a_temp(1,1)=agg(l,1)
5052 a_temp(1,2)=agg(l,2)
5053 a_temp(2,1)=agg(l,3)
5054 a_temp(2,2)=agg(l,4)
5055 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5056 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5057 s1=scalar2(b1(1,i+2),auxvec(1))
5058 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5059 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5060 s2=scalar2(b1(1,i+1),auxvec(1))
5061 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5062 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5063 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5065 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
5066 & *fac_shield(i)*fac_shield(j)
5069 C Remaining derivatives of this turn contribution
5071 a_temp(1,1)=aggi(l,1)
5072 a_temp(1,2)=aggi(l,2)
5073 a_temp(2,1)=aggi(l,3)
5074 a_temp(2,2)=aggi(l,4)
5075 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5076 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5077 s1=scalar2(b1(1,i+2),auxvec(1))
5078 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5079 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5080 s2=scalar2(b1(1,i+1),auxvec(1))
5081 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5082 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5083 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5084 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
5085 & *fac_shield(i)*fac_shield(j)
5086 a_temp(1,1)=aggi1(l,1)
5087 a_temp(1,2)=aggi1(l,2)
5088 a_temp(2,1)=aggi1(l,3)
5089 a_temp(2,2)=aggi1(l,4)
5090 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5091 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5092 s1=scalar2(b1(1,i+2),auxvec(1))
5093 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5094 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5095 s2=scalar2(b1(1,i+1),auxvec(1))
5096 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5097 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5098 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5099 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
5100 & *fac_shield(i)*fac_shield(j)
5101 a_temp(1,1)=aggj(l,1)
5102 a_temp(1,2)=aggj(l,2)
5103 a_temp(2,1)=aggj(l,3)
5104 a_temp(2,2)=aggj(l,4)
5105 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5106 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5107 s1=scalar2(b1(1,i+2),auxvec(1))
5108 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5109 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5110 s2=scalar2(b1(1,i+1),auxvec(1))
5111 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5112 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5113 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5114 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
5115 & *fac_shield(i)*fac_shield(j)
5116 a_temp(1,1)=aggj1(l,1)
5117 a_temp(1,2)=aggj1(l,2)
5118 a_temp(2,1)=aggj1(l,3)
5119 a_temp(2,2)=aggj1(l,4)
5120 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5121 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5122 s1=scalar2(b1(1,i+2),auxvec(1))
5123 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5124 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5125 s2=scalar2(b1(1,i+1),auxvec(1))
5126 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5127 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5128 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5129 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5130 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
5131 & *fac_shield(i)*fac_shield(j)
5135 C-----------------------------------------------------------------------------
5136 subroutine vecpr(u,v,w)
5137 implicit real*8(a-h,o-z)
5138 dimension u(3),v(3),w(3)
5139 w(1)=u(2)*v(3)-u(3)*v(2)
5140 w(2)=-u(1)*v(3)+u(3)*v(1)
5141 w(3)=u(1)*v(2)-u(2)*v(1)
5144 C-----------------------------------------------------------------------------
5145 subroutine unormderiv(u,ugrad,unorm,ungrad)
5146 C This subroutine computes the derivatives of a normalized vector u, given
5147 C the derivatives computed without normalization conditions, ugrad. Returns
5150 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
5151 double precision vec(3)
5152 double precision scalar
5154 c write (2,*) 'ugrad',ugrad
5157 vec(i)=scalar(ugrad(1,i),u(1))
5159 c write (2,*) 'vec',vec
5162 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5165 c write (2,*) 'ungrad',ungrad
5168 C-----------------------------------------------------------------------------
5169 subroutine escp_soft_sphere(evdw2,evdw2_14)
5171 C This subroutine calculates the excluded-volume interaction energy between
5172 C peptide-group centers and side chains and its gradient in virtual-bond and
5173 C side-chain vectors.
5175 implicit real*8 (a-h,o-z)
5176 include 'DIMENSIONS'
5177 include 'COMMON.GEO'
5178 include 'COMMON.VAR'
5179 include 'COMMON.LOCAL'
5180 include 'COMMON.CHAIN'
5181 include 'COMMON.DERIV'
5182 include 'COMMON.INTERACT'
5183 include 'COMMON.FFIELD'
5184 include 'COMMON.IOUNITS'
5185 include 'COMMON.CONTROL'
5190 cd print '(a)','Enter ESCP'
5191 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5195 do i=iatscp_s,iatscp_e
5196 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5198 xi=0.5D0*(c(1,i)+c(1,i+1))
5199 yi=0.5D0*(c(2,i)+c(2,i+1))
5200 zi=0.5D0*(c(3,i)+c(3,i+1))
5201 C Return atom into box, boxxsize is size of box in x dimension
5203 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5204 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5205 C Condition for being inside the proper box
5206 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5207 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5211 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5212 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5213 C Condition for being inside the proper box
5214 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5215 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5219 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5220 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5221 cC Condition for being inside the proper box
5222 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5223 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5227 if (xi.lt.0) xi=xi+boxxsize
5229 if (yi.lt.0) yi=yi+boxysize
5231 if (zi.lt.0) zi=zi+boxzsize
5232 C xi=xi+xshift*boxxsize
5233 C yi=yi+yshift*boxysize
5234 C zi=zi+zshift*boxzsize
5235 do iint=1,nscp_gr(i)
5237 do j=iscpstart(i,iint),iscpend(i,iint)
5238 if (itype(j).eq.ntyp1) cycle
5239 itypj=iabs(itype(j))
5240 C Uncomment following three lines for SC-p interactions
5244 C Uncomment following three lines for Ca-p interactions
5249 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5250 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5251 C Condition for being inside the proper box
5252 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5253 c & (xj.lt.((-0.5d0)*boxxsize))) then
5257 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5258 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5259 cC Condition for being inside the proper box
5260 c if ((yj.gt.((0.5d0)*boxysize)).or.
5261 c & (yj.lt.((-0.5d0)*boxysize))) then
5265 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5266 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5267 C Condition for being inside the proper box
5268 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5269 c & (zj.lt.((-0.5d0)*boxzsize))) then
5272 if (xj.lt.0) xj=xj+boxxsize
5274 if (yj.lt.0) yj=yj+boxysize
5276 if (zj.lt.0) zj=zj+boxzsize
5277 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5285 xj=xj_safe+xshift*boxxsize
5286 yj=yj_safe+yshift*boxysize
5287 zj=zj_safe+zshift*boxzsize
5288 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5289 if(dist_temp.lt.dist_init) then
5299 if (subchap.eq.1) then
5312 rij=xj*xj+yj*yj+zj*zj
5316 if (rij.lt.r0ijsq) then
5317 evdwij=0.25d0*(rij-r0ijsq)**2
5325 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5330 cgrad if (j.lt.i) then
5331 cd write (iout,*) 'j<i'
5332 C Uncomment following three lines for SC-p interactions
5334 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5337 cd write (iout,*) 'j>i'
5339 cgrad ggg(k)=-ggg(k)
5340 C Uncomment following line for SC-p interactions
5341 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5345 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5347 cgrad kstart=min0(i+1,j)
5348 cgrad kend=max0(i-1,j-1)
5349 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5350 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5351 cgrad do k=kstart,kend
5353 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5357 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5358 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5369 C-----------------------------------------------------------------------------
5370 subroutine escp(evdw2,evdw2_14)
5372 C This subroutine calculates the excluded-volume interaction energy between
5373 C peptide-group centers and side chains and its gradient in virtual-bond and
5374 C side-chain vectors.
5376 implicit real*8 (a-h,o-z)
5377 include 'DIMENSIONS'
5378 include 'COMMON.GEO'
5379 include 'COMMON.VAR'
5380 include 'COMMON.LOCAL'
5381 include 'COMMON.CHAIN'
5382 include 'COMMON.DERIV'
5383 include 'COMMON.INTERACT'
5384 include 'COMMON.FFIELD'
5385 include 'COMMON.IOUNITS'
5386 include 'COMMON.CONTROL'
5387 include 'COMMON.SPLITELE'
5391 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
5392 cd print '(a)','Enter ESCP'
5393 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5397 do i=iatscp_s,iatscp_e
5398 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5400 xi=0.5D0*(c(1,i)+c(1,i+1))
5401 yi=0.5D0*(c(2,i)+c(2,i+1))
5402 zi=0.5D0*(c(3,i)+c(3,i+1))
5404 if (xi.lt.0) xi=xi+boxxsize
5406 if (yi.lt.0) yi=yi+boxysize
5408 if (zi.lt.0) zi=zi+boxzsize
5409 c xi=xi+xshift*boxxsize
5410 c yi=yi+yshift*boxysize
5411 c zi=zi+zshift*boxzsize
5412 c print *,xi,yi,zi,'polozenie i'
5413 C Return atom into box, boxxsize is size of box in x dimension
5415 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5416 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5417 C Condition for being inside the proper box
5418 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5419 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5423 c print *,xi,boxxsize,"pierwszy"
5425 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5426 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5427 C Condition for being inside the proper box
5428 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5429 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5433 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5434 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5435 C Condition for being inside the proper box
5436 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5437 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5440 do iint=1,nscp_gr(i)
5442 do j=iscpstart(i,iint),iscpend(i,iint)
5443 itypj=iabs(itype(j))
5444 if (itypj.eq.ntyp1) cycle
5445 C Uncomment following three lines for SC-p interactions
5449 C Uncomment following three lines for Ca-p interactions
5454 if (xj.lt.0) xj=xj+boxxsize
5456 if (yj.lt.0) yj=yj+boxysize
5458 if (zj.lt.0) zj=zj+boxzsize
5460 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5461 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5462 C Condition for being inside the proper box
5463 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5464 c & (xj.lt.((-0.5d0)*boxxsize))) then
5468 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5469 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5470 cC Condition for being inside the proper box
5471 c if ((yj.gt.((0.5d0)*boxysize)).or.
5472 c & (yj.lt.((-0.5d0)*boxysize))) then
5476 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5477 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5478 C Condition for being inside the proper box
5479 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5480 c & (zj.lt.((-0.5d0)*boxzsize))) then
5483 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5484 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5492 xj=xj_safe+xshift*boxxsize
5493 yj=yj_safe+yshift*boxysize
5494 zj=zj_safe+zshift*boxzsize
5495 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5496 if(dist_temp.lt.dist_init) then
5506 if (subchap.eq.1) then
5515 c print *,xj,yj,zj,'polozenie j'
5516 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5518 sss=sscale(1.0d0/(dsqrt(rrij)))
5519 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5520 c if (sss.eq.0) print *,'czasem jest OK'
5521 if (sss.le.0.0d0) cycle
5522 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5524 e1=fac*fac*aad(itypj,iteli)
5525 e2=fac*bad(itypj,iteli)
5526 if (iabs(j-i) .le. 2) then
5529 evdw2_14=evdw2_14+(e1+e2)*sss
5532 evdw2=evdw2+evdwij*sss
5533 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5534 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5537 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5539 fac=-(evdwij+e1)*rrij*sss
5540 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5544 cgrad if (j.lt.i) then
5545 cd write (iout,*) 'j<i'
5546 C Uncomment following three lines for SC-p interactions
5548 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5551 cd write (iout,*) 'j>i'
5553 cgrad ggg(k)=-ggg(k)
5554 C Uncomment following line for SC-p interactions
5555 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5556 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5560 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5562 cgrad kstart=min0(i+1,j)
5563 cgrad kend=max0(i-1,j-1)
5564 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5565 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5566 cgrad do k=kstart,kend
5568 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5572 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5573 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5575 c endif !endif for sscale cutoff
5585 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5586 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5587 gradx_scp(j,i)=expon*gradx_scp(j,i)
5590 C******************************************************************************
5594 C To save time the factor EXPON has been extracted from ALL components
5595 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5598 C******************************************************************************
5601 C--------------------------------------------------------------------------
5602 subroutine edis(ehpb)
5604 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5606 implicit real*8 (a-h,o-z)
5607 include 'DIMENSIONS'
5608 include 'COMMON.SBRIDGE'
5609 include 'COMMON.CHAIN'
5610 include 'COMMON.DERIV'
5611 include 'COMMON.VAR'
5612 include 'COMMON.INTERACT'
5613 include 'COMMON.IOUNITS'
5614 include 'COMMON.CONTROL'
5620 C write (iout,*) ,"link_end",link_end,constr_dist
5621 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5622 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5623 if (link_end.eq.0) return
5624 do i=link_start,link_end
5625 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5626 C CA-CA distance used in regularization of structure.
5629 C iii and jjj point to the residues for which the distance is assigned.
5630 if (ii.gt.nres) then
5637 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5638 c & dhpb(i),dhpb1(i),forcon(i)
5639 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5640 C distance and angle dependent SS bond potential.
5641 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5642 C & iabs(itype(jjj)).eq.1) then
5643 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5644 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5645 if (.not.dyn_ss .and. i.le.nss) then
5646 C 15/02/13 CC dynamic SSbond - additional check
5647 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5648 & iabs(itype(jjj)).eq.1) then
5649 call ssbond_ene(iii,jjj,eij)
5652 cd write (iout,*) "eij",eij
5653 cd & ' waga=',waga,' fac=',fac
5654 else if (ii.gt.nres .and. jj.gt.nres) then
5655 c Restraints from contact prediction
5657 if (constr_dist.eq.11) then
5658 ehpb=ehpb+fordepth(i)**4.0d0
5659 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5660 fac=fordepth(i)**4.0d0
5661 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5662 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5663 & ehpb,fordepth(i),dd
5665 if (dhpb1(i).gt.0.0d0) then
5666 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5667 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5668 c write (iout,*) "beta nmr",
5669 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5673 C Get the force constant corresponding to this distance.
5675 C Calculate the contribution to energy.
5676 ehpb=ehpb+waga*rdis*rdis
5677 c write (iout,*) "beta reg",dd,waga*rdis*rdis
5679 C Evaluate gradient.
5685 ggg(j)=fac*(c(j,jj)-c(j,ii))
5688 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5689 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5692 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5693 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5696 C Calculate the distance between the two points and its difference from the
5699 if (constr_dist.eq.11) then
5700 ehpb=ehpb+fordepth(i)**4.0d0
5701 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5702 fac=fordepth(i)**4.0d0
5703 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5704 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5705 & ehpb,fordepth(i),dd
5707 if (dhpb1(i).gt.0.0d0) then
5708 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5709 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5710 c write (iout,*) "alph nmr",
5711 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5714 C Get the force constant corresponding to this distance.
5716 C Calculate the contribution to energy.
5717 ehpb=ehpb+waga*rdis*rdis
5718 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5720 C Evaluate gradient.
5726 ggg(j)=fac*(c(j,jj)-c(j,ii))
5728 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5729 C If this is a SC-SC distance, we need to calculate the contributions to the
5730 C Cartesian gradient in the SC vectors (ghpbx).
5733 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5734 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5737 cgrad do j=iii,jjj-1
5739 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5743 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5744 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5748 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5751 C--------------------------------------------------------------------------
5752 subroutine ssbond_ene(i,j,eij)
5754 C Calculate the distance and angle dependent SS-bond potential energy
5755 C using a free-energy function derived based on RHF/6-31G** ab initio
5756 C calculations of diethyl disulfide.
5758 C A. Liwo and U. Kozlowska, 11/24/03
5760 implicit real*8 (a-h,o-z)
5761 include 'DIMENSIONS'
5762 include 'COMMON.SBRIDGE'
5763 include 'COMMON.CHAIN'
5764 include 'COMMON.DERIV'
5765 include 'COMMON.LOCAL'
5766 include 'COMMON.INTERACT'
5767 include 'COMMON.VAR'
5768 include 'COMMON.IOUNITS'
5769 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5770 itypi=iabs(itype(i))
5774 dxi=dc_norm(1,nres+i)
5775 dyi=dc_norm(2,nres+i)
5776 dzi=dc_norm(3,nres+i)
5777 c dsci_inv=dsc_inv(itypi)
5778 dsci_inv=vbld_inv(nres+i)
5779 itypj=iabs(itype(j))
5780 c dscj_inv=dsc_inv(itypj)
5781 dscj_inv=vbld_inv(nres+j)
5785 dxj=dc_norm(1,nres+j)
5786 dyj=dc_norm(2,nres+j)
5787 dzj=dc_norm(3,nres+j)
5788 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5793 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5794 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5795 om12=dxi*dxj+dyi*dyj+dzi*dzj
5797 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5798 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5804 deltat12=om2-om1+2.0d0
5806 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5807 & +akct*deltad*deltat12
5808 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5809 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5810 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5811 c & " deltat12",deltat12," eij",eij
5812 ed=2*akcm*deltad+akct*deltat12
5814 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5815 eom1=-2*akth*deltat1-pom1-om2*pom2
5816 eom2= 2*akth*deltat2+pom1-om1*pom2
5819 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5820 ghpbx(k,i)=ghpbx(k,i)-ggk
5821 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5822 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5823 ghpbx(k,j)=ghpbx(k,j)+ggk
5824 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5825 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5826 ghpbc(k,i)=ghpbc(k,i)-ggk
5827 ghpbc(k,j)=ghpbc(k,j)+ggk
5830 C Calculate the components of the gradient in DC and X
5834 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5839 C--------------------------------------------------------------------------
5840 subroutine ebond(estr)
5842 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5844 implicit real*8 (a-h,o-z)
5845 include 'DIMENSIONS'
5846 include 'COMMON.LOCAL'
5847 include 'COMMON.GEO'
5848 include 'COMMON.INTERACT'
5849 include 'COMMON.DERIV'
5850 include 'COMMON.VAR'
5851 include 'COMMON.CHAIN'
5852 include 'COMMON.IOUNITS'
5853 include 'COMMON.NAMES'
5854 include 'COMMON.FFIELD'
5855 include 'COMMON.CONTROL'
5856 include 'COMMON.SETUP'
5857 double precision u(3),ud(3)
5860 do i=ibondp_start,ibondp_end
5861 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5862 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5864 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5865 c & *dc(j,i-1)/vbld(i)
5867 c if (energy_dec) write(iout,*)
5868 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5870 C Checking if it involves dummy (NH3+ or COO-) group
5871 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5872 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5873 diff = vbld(i)-vbldpDUM
5874 if (energy_dec) write(iout,*) "dum_bond",i,diff
5876 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5877 diff = vbld(i)-vbldp0
5879 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5880 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5883 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5885 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5889 estr=0.5d0*AKP*estr+estr1
5891 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5893 do i=ibond_start,ibond_end
5895 if (iti.ne.10 .and. iti.ne.ntyp1) then
5898 diff=vbld(i+nres)-vbldsc0(1,iti)
5899 if (energy_dec) write (iout,*)
5900 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5901 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5902 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5904 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5908 diff=vbld(i+nres)-vbldsc0(j,iti)
5909 ud(j)=aksc(j,iti)*diff
5910 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5924 uprod2=uprod2*u(k)*u(k)
5928 usumsqder=usumsqder+ud(j)*uprod2
5930 estr=estr+uprod/usum
5932 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5940 C--------------------------------------------------------------------------
5941 subroutine ebend(etheta,ethetacnstr)
5943 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5944 C angles gamma and its derivatives in consecutive thetas and gammas.
5946 implicit real*8 (a-h,o-z)
5947 include 'DIMENSIONS'
5948 include 'COMMON.LOCAL'
5949 include 'COMMON.GEO'
5950 include 'COMMON.INTERACT'
5951 include 'COMMON.DERIV'
5952 include 'COMMON.VAR'
5953 include 'COMMON.CHAIN'
5954 include 'COMMON.IOUNITS'
5955 include 'COMMON.NAMES'
5956 include 'COMMON.FFIELD'
5957 include 'COMMON.CONTROL'
5958 include 'COMMON.TORCNSTR'
5959 common /calcthet/ term1,term2,termm,diffak,ratak,
5960 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5961 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5962 double precision y(2),z(2)
5964 c time11=dexp(-2*time)
5967 c write (*,'(a,i2)') 'EBEND ICG=',icg
5968 do i=ithet_start,ithet_end
5969 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5970 & .or.itype(i).eq.ntyp1) cycle
5971 C Zero the energy function and its derivative at 0 or pi.
5972 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5974 ichir1=isign(1,itype(i-2))
5975 ichir2=isign(1,itype(i))
5976 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5977 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5978 if (itype(i-1).eq.10) then
5979 itype1=isign(10,itype(i-2))
5980 ichir11=isign(1,itype(i-2))
5981 ichir12=isign(1,itype(i-2))
5982 itype2=isign(10,itype(i))
5983 ichir21=isign(1,itype(i))
5984 ichir22=isign(1,itype(i))
5987 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5990 if (phii.ne.phii) phii=150.0
6000 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6003 if (phii1.ne.phii1) phii1=150.0
6015 C Calculate the "mean" value of theta from the part of the distribution
6016 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
6017 C In following comments this theta will be referred to as t_c.
6018 thet_pred_mean=0.0d0
6020 athetk=athet(k,it,ichir1,ichir2)
6021 bthetk=bthet(k,it,ichir1,ichir2)
6023 athetk=athet(k,itype1,ichir11,ichir12)
6024 bthetk=bthet(k,itype2,ichir21,ichir22)
6026 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
6027 c write(iout,*) 'chuj tu', y(k),z(k)
6029 dthett=thet_pred_mean*ssd
6030 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
6031 C Derivatives of the "mean" values in gamma1 and gamma2.
6032 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
6033 &+athet(2,it,ichir1,ichir2)*y(1))*ss
6034 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
6035 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
6037 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
6038 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
6039 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
6040 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
6042 if (theta(i).gt.pi-delta) then
6043 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
6045 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
6046 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6047 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
6049 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
6051 else if (theta(i).lt.delta) then
6052 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
6053 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6054 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
6056 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
6057 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
6060 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
6063 etheta=etheta+ethetai
6064 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
6065 & 'ebend',i,ethetai,theta(i),itype(i)
6066 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
6067 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
6068 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
6071 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6072 do i=ithetaconstr_start,ithetaconstr_end
6073 itheta=itheta_constr(i)
6074 thetiii=theta(itheta)
6075 difi=pinorm(thetiii-theta_constr0(i))
6076 if (difi.gt.theta_drange(i)) then
6077 difi=difi-theta_drange(i)
6078 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6079 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6080 & +for_thet_constr(i)*difi**3
6081 else if (difi.lt.-drange(i)) then
6083 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6084 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6085 & +for_thet_constr(i)*difi**3
6089 if (energy_dec) then
6090 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6091 & i,itheta,rad2deg*thetiii,
6092 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6093 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6094 & gloc(itheta+nphi-2,icg)
6098 C Ufff.... We've done all this!!!
6101 C---------------------------------------------------------------------------
6102 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
6104 implicit real*8 (a-h,o-z)
6105 include 'DIMENSIONS'
6106 include 'COMMON.LOCAL'
6107 include 'COMMON.IOUNITS'
6108 common /calcthet/ term1,term2,termm,diffak,ratak,
6109 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6110 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6111 C Calculate the contributions to both Gaussian lobes.
6112 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6113 C The "polynomial part" of the "standard deviation" of this part of
6114 C the distributioni.
6115 ccc write (iout,*) thetai,thet_pred_mean
6118 sig=sig*thet_pred_mean+polthet(j,it)
6120 C Derivative of the "interior part" of the "standard deviation of the"
6121 C gamma-dependent Gaussian lobe in t_c.
6122 sigtc=3*polthet(3,it)
6124 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6127 C Set the parameters of both Gaussian lobes of the distribution.
6128 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6129 fac=sig*sig+sigc0(it)
6132 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6133 sigsqtc=-4.0D0*sigcsq*sigtc
6134 c print *,i,sig,sigtc,sigsqtc
6135 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
6136 sigtc=-sigtc/(fac*fac)
6137 C Following variable is sigma(t_c)**(-2)
6138 sigcsq=sigcsq*sigcsq
6140 sig0inv=1.0D0/sig0i**2
6141 delthec=thetai-thet_pred_mean
6142 delthe0=thetai-theta0i
6143 term1=-0.5D0*sigcsq*delthec*delthec
6144 term2=-0.5D0*sig0inv*delthe0*delthe0
6145 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
6146 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6147 C NaNs in taking the logarithm. We extract the largest exponent which is added
6148 C to the energy (this being the log of the distribution) at the end of energy
6149 C term evaluation for this virtual-bond angle.
6150 if (term1.gt.term2) then
6152 term2=dexp(term2-termm)
6156 term1=dexp(term1-termm)
6159 C The ratio between the gamma-independent and gamma-dependent lobes of
6160 C the distribution is a Gaussian function of thet_pred_mean too.
6161 diffak=gthet(2,it)-thet_pred_mean
6162 ratak=diffak/gthet(3,it)**2
6163 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6164 C Let's differentiate it in thet_pred_mean NOW.
6166 C Now put together the distribution terms to make complete distribution.
6167 termexp=term1+ak*term2
6168 termpre=sigc+ak*sig0i
6169 C Contribution of the bending energy from this theta is just the -log of
6170 C the sum of the contributions from the two lobes and the pre-exponential
6171 C factor. Simple enough, isn't it?
6172 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6173 C write (iout,*) 'termexp',termexp,termm,termpre,i
6174 C NOW the derivatives!!!
6175 C 6/6/97 Take into account the deformation.
6176 E_theta=(delthec*sigcsq*term1
6177 & +ak*delthe0*sig0inv*term2)/termexp
6178 E_tc=((sigtc+aktc*sig0i)/termpre
6179 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
6180 & aktc*term2)/termexp)
6183 c-----------------------------------------------------------------------------
6184 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
6185 implicit real*8 (a-h,o-z)
6186 include 'DIMENSIONS'
6187 include 'COMMON.LOCAL'
6188 include 'COMMON.IOUNITS'
6189 common /calcthet/ term1,term2,termm,diffak,ratak,
6190 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6191 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6192 delthec=thetai-thet_pred_mean
6193 delthe0=thetai-theta0i
6194 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
6195 t3 = thetai-thet_pred_mean
6199 t14 = t12+t6*sigsqtc
6201 t21 = thetai-theta0i
6207 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
6208 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
6209 & *(-t12*t9-ak*sig0inv*t27)
6213 C--------------------------------------------------------------------------
6214 subroutine ebend(etheta,ethetacnstr)
6216 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6217 C angles gamma and its derivatives in consecutive thetas and gammas.
6218 C ab initio-derived potentials from
6219 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6221 implicit real*8 (a-h,o-z)
6222 include 'DIMENSIONS'
6223 include 'COMMON.LOCAL'
6224 include 'COMMON.GEO'
6225 include 'COMMON.INTERACT'
6226 include 'COMMON.DERIV'
6227 include 'COMMON.VAR'
6228 include 'COMMON.CHAIN'
6229 include 'COMMON.IOUNITS'
6230 include 'COMMON.NAMES'
6231 include 'COMMON.FFIELD'
6232 include 'COMMON.CONTROL'
6233 include 'COMMON.TORCNSTR'
6234 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
6235 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
6236 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
6237 & sinph1ph2(maxdouble,maxdouble)
6238 logical lprn /.false./, lprn1 /.false./
6240 do i=ithet_start,ithet_end
6241 c print *,i,itype(i-1),itype(i),itype(i-2)
6242 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6243 & .or.itype(i).eq.ntyp1) cycle
6244 C print *,i,theta(i)
6245 if (iabs(itype(i+1)).eq.20) iblock=2
6246 if (iabs(itype(i+1)).ne.20) iblock=1
6250 theti2=0.5d0*theta(i)
6251 ityp2=ithetyp((itype(i-1)))
6253 coskt(k)=dcos(k*theti2)
6254 sinkt(k)=dsin(k*theti2)
6257 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
6260 if (phii.ne.phii) phii=150.0
6264 ityp1=ithetyp((itype(i-2)))
6265 C propagation of chirality for glycine type
6267 cosph1(k)=dcos(k*phii)
6268 sinph1(k)=dsin(k*phii)
6273 ityp1=ithetyp((itype(i-2)))
6278 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6281 if (phii1.ne.phii1) phii1=150.0
6286 ityp3=ithetyp((itype(i)))
6288 cosph2(k)=dcos(k*phii1)
6289 sinph2(k)=dsin(k*phii1)
6293 ityp3=ithetyp((itype(i)))
6299 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
6302 ccl=cosph1(l)*cosph2(k-l)
6303 ssl=sinph1(l)*sinph2(k-l)
6304 scl=sinph1(l)*cosph2(k-l)
6305 csl=cosph1(l)*sinph2(k-l)
6306 cosph1ph2(l,k)=ccl-ssl
6307 cosph1ph2(k,l)=ccl+ssl
6308 sinph1ph2(l,k)=scl+csl
6309 sinph1ph2(k,l)=scl-csl
6313 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
6314 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6315 write (iout,*) "coskt and sinkt"
6317 write (iout,*) k,coskt(k),sinkt(k)
6321 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6322 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
6325 & write (iout,*) "k",k,"
6326 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
6327 & " ethetai",ethetai
6330 write (iout,*) "cosph and sinph"
6332 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6334 write (iout,*) "cosph1ph2 and sinph2ph2"
6337 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6338 & sinph1ph2(l,k),sinph1ph2(k,l)
6341 write(iout,*) "ethetai",ethetai
6346 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
6347 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
6348 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
6349 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6350 ethetai=ethetai+sinkt(m)*aux
6351 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6352 dephii=dephii+k*sinkt(m)*(
6353 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
6354 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6355 dephii1=dephii1+k*sinkt(m)*(
6356 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
6357 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6359 & write (iout,*) "m",m," k",k," bbthet",
6360 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
6361 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
6362 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
6363 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6364 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6367 C print *,"cosph1", (cosph1(k), k=1,nsingle)
6368 C print *,"cosph2", (cosph2(k), k=1,nsingle)
6369 C print *,"sinph1", (sinph1(k), k=1,nsingle)
6370 C print *,"sinph2", (sinph2(k), k=1,nsingle)
6372 & write(iout,*) "ethetai",ethetai
6373 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6377 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6378 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
6379 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6380 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6381 ethetai=ethetai+sinkt(m)*aux
6382 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6383 dephii=dephii+l*sinkt(m)*(
6384 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
6385 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6386 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6387 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6388 dephii1=dephii1+(k-l)*sinkt(m)*(
6389 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6390 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6391 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
6392 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6394 write (iout,*) "m",m," k",k," l",l," ffthet",
6395 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6396 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
6397 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6398 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
6399 & " ethetai",ethetai
6400 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6401 & cosph1ph2(k,l)*sinkt(m),
6402 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6411 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6412 & i,theta(i)*rad2deg,phii*rad2deg,
6413 & phii1*rad2deg,ethetai
6415 etheta=etheta+ethetai
6416 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6417 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6418 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
6422 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6423 do i=ithetaconstr_start,ithetaconstr_end
6424 itheta=itheta_constr(i)
6425 thetiii=theta(itheta)
6426 difi=pinorm(thetiii-theta_constr0(i))
6427 if (difi.gt.theta_drange(i)) then
6428 difi=difi-theta_drange(i)
6429 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6430 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6431 & +for_thet_constr(i)*difi**3
6432 else if (difi.lt.-drange(i)) then
6434 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6435 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6436 & +for_thet_constr(i)*difi**3
6440 if (energy_dec) then
6441 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6442 & i,itheta,rad2deg*thetiii,
6443 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6444 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6445 & gloc(itheta+nphi-2,icg)
6453 c-----------------------------------------------------------------------------
6454 subroutine esc(escloc)
6455 C Calculate the local energy of a side chain and its derivatives in the
6456 C corresponding virtual-bond valence angles THETA and the spherical angles
6458 implicit real*8 (a-h,o-z)
6459 include 'DIMENSIONS'
6460 include 'COMMON.GEO'
6461 include 'COMMON.LOCAL'
6462 include 'COMMON.VAR'
6463 include 'COMMON.INTERACT'
6464 include 'COMMON.DERIV'
6465 include 'COMMON.CHAIN'
6466 include 'COMMON.IOUNITS'
6467 include 'COMMON.NAMES'
6468 include 'COMMON.FFIELD'
6469 include 'COMMON.CONTROL'
6470 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6471 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6472 common /sccalc/ time11,time12,time112,theti,it,nlobit
6475 c write (iout,'(a)') 'ESC'
6476 do i=loc_start,loc_end
6478 if (it.eq.ntyp1) cycle
6479 if (it.eq.10) goto 1
6480 nlobit=nlob(iabs(it))
6481 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6482 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6483 theti=theta(i+1)-pipol
6488 if (x(2).gt.pi-delta) then
6492 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6494 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6495 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6497 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6498 & ddersc0(1),dersc(1))
6499 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6500 & ddersc0(3),dersc(3))
6502 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6504 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6505 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6506 & dersc0(2),esclocbi,dersc02)
6507 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6509 call splinthet(x(2),0.5d0*delta,ss,ssd)
6514 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6516 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6517 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6519 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6521 c write (iout,*) escloci
6522 else if (x(2).lt.delta) then
6526 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6528 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6529 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6531 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6532 & ddersc0(1),dersc(1))
6533 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6534 & ddersc0(3),dersc(3))
6536 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6538 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6539 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6540 & dersc0(2),esclocbi,dersc02)
6541 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6546 call splinthet(x(2),0.5d0*delta,ss,ssd)
6548 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6550 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6551 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6553 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6554 c write (iout,*) escloci
6556 call enesc(x,escloci,dersc,ddummy,.false.)
6559 escloc=escloc+escloci
6560 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6561 & 'escloc',i,escloci
6562 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6564 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6566 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6567 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6572 C---------------------------------------------------------------------------
6573 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6574 implicit real*8 (a-h,o-z)
6575 include 'DIMENSIONS'
6576 include 'COMMON.GEO'
6577 include 'COMMON.LOCAL'
6578 include 'COMMON.IOUNITS'
6579 common /sccalc/ time11,time12,time112,theti,it,nlobit
6580 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6581 double precision contr(maxlob,-1:1)
6583 c write (iout,*) 'it=',it,' nlobit=',nlobit
6587 if (mixed) ddersc(j)=0.0d0
6591 C Because of periodicity of the dependence of the SC energy in omega we have
6592 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6593 C To avoid underflows, first compute & store the exponents.
6601 z(k)=x(k)-censc(k,j,it)
6606 Axk=Axk+gaussc(l,k,j,it)*z(l)
6612 expfac=expfac+Ax(k,j,iii)*z(k)
6620 C As in the case of ebend, we want to avoid underflows in exponentiation and
6621 C subsequent NaNs and INFs in energy calculation.
6622 C Find the largest exponent
6626 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6630 cd print *,'it=',it,' emin=',emin
6632 C Compute the contribution to SC energy and derivatives
6637 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6638 if(adexp.ne.adexp) adexp=1.0
6641 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6643 cd print *,'j=',j,' expfac=',expfac
6644 escloc_i=escloc_i+expfac
6646 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6650 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6651 & +gaussc(k,2,j,it))*expfac
6658 dersc(1)=dersc(1)/cos(theti)**2
6659 ddersc(1)=ddersc(1)/cos(theti)**2
6662 escloci=-(dlog(escloc_i)-emin)
6664 dersc(j)=dersc(j)/escloc_i
6668 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6673 C------------------------------------------------------------------------------
6674 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6675 implicit real*8 (a-h,o-z)
6676 include 'DIMENSIONS'
6677 include 'COMMON.GEO'
6678 include 'COMMON.LOCAL'
6679 include 'COMMON.IOUNITS'
6680 common /sccalc/ time11,time12,time112,theti,it,nlobit
6681 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6682 double precision contr(maxlob)
6693 z(k)=x(k)-censc(k,j,it)
6699 Axk=Axk+gaussc(l,k,j,it)*z(l)
6705 expfac=expfac+Ax(k,j)*z(k)
6710 C As in the case of ebend, we want to avoid underflows in exponentiation and
6711 C subsequent NaNs and INFs in energy calculation.
6712 C Find the largest exponent
6715 if (emin.gt.contr(j)) emin=contr(j)
6719 C Compute the contribution to SC energy and derivatives
6723 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6724 escloc_i=escloc_i+expfac
6726 dersc(k)=dersc(k)+Ax(k,j)*expfac
6728 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6729 & +gaussc(1,2,j,it))*expfac
6733 dersc(1)=dersc(1)/cos(theti)**2
6734 dersc12=dersc12/cos(theti)**2
6735 escloci=-(dlog(escloc_i)-emin)
6737 dersc(j)=dersc(j)/escloc_i
6739 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6743 c----------------------------------------------------------------------------------
6744 subroutine esc(escloc)
6745 C Calculate the local energy of a side chain and its derivatives in the
6746 C corresponding virtual-bond valence angles THETA and the spherical angles
6747 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6748 C added by Urszula Kozlowska. 07/11/2007
6750 implicit real*8 (a-h,o-z)
6751 include 'DIMENSIONS'
6752 include 'COMMON.GEO'
6753 include 'COMMON.LOCAL'
6754 include 'COMMON.VAR'
6755 include 'COMMON.SCROT'
6756 include 'COMMON.INTERACT'
6757 include 'COMMON.DERIV'
6758 include 'COMMON.CHAIN'
6759 include 'COMMON.IOUNITS'
6760 include 'COMMON.NAMES'
6761 include 'COMMON.FFIELD'
6762 include 'COMMON.CONTROL'
6763 include 'COMMON.VECTORS'
6764 double precision x_prime(3),y_prime(3),z_prime(3)
6765 & , sumene,dsc_i,dp2_i,x(65),
6766 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6767 & de_dxx,de_dyy,de_dzz,de_dt
6768 double precision s1_t,s1_6_t,s2_t,s2_6_t
6770 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6771 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6772 & dt_dCi(3),dt_dCi1(3)
6773 common /sccalc/ time11,time12,time112,theti,it,nlobit
6776 do i=loc_start,loc_end
6777 if (itype(i).eq.ntyp1) cycle
6778 costtab(i+1) =dcos(theta(i+1))
6779 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6780 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6781 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6782 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6783 cosfac=dsqrt(cosfac2)
6784 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6785 sinfac=dsqrt(sinfac2)
6787 if (it.eq.10) goto 1
6789 C Compute the axes of tghe local cartesian coordinates system; store in
6790 c x_prime, y_prime and z_prime
6797 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6798 C & dc_norm(3,i+nres)
6800 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6801 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6804 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6807 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6808 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6809 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6810 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6811 c & " xy",scalar(x_prime(1),y_prime(1)),
6812 c & " xz",scalar(x_prime(1),z_prime(1)),
6813 c & " yy",scalar(y_prime(1),y_prime(1)),
6814 c & " yz",scalar(y_prime(1),z_prime(1)),
6815 c & " zz",scalar(z_prime(1),z_prime(1))
6817 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6818 C to local coordinate system. Store in xx, yy, zz.
6824 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6825 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6826 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6833 C Compute the energy of the ith side cbain
6835 c write (2,*) "xx",xx," yy",yy," zz",zz
6838 x(j) = sc_parmin(j,it)
6841 Cc diagnostics - remove later
6843 yy1 = dsin(alph(2))*dcos(omeg(2))
6844 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6845 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6846 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6848 C," --- ", xx_w,yy_w,zz_w
6851 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6852 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6854 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6855 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6857 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6858 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6859 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6860 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6861 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6863 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6864 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6865 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6866 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6867 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6869 dsc_i = 0.743d0+x(61)
6871 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6872 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6873 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6874 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6875 s1=(1+x(63))/(0.1d0 + dscp1)
6876 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6877 s2=(1+x(65))/(0.1d0 + dscp2)
6878 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6879 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6880 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6881 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6883 c & dscp1,dscp2,sumene
6884 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6885 escloc = escloc + sumene
6886 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6891 C This section to check the numerical derivatives of the energy of ith side
6892 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6893 C #define DEBUG in the code to turn it on.
6895 write (2,*) "sumene =",sumene
6899 write (2,*) xx,yy,zz
6900 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6901 de_dxx_num=(sumenep-sumene)/aincr
6903 write (2,*) "xx+ sumene from enesc=",sumenep
6906 write (2,*) xx,yy,zz
6907 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6908 de_dyy_num=(sumenep-sumene)/aincr
6910 write (2,*) "yy+ sumene from enesc=",sumenep
6913 write (2,*) xx,yy,zz
6914 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6915 de_dzz_num=(sumenep-sumene)/aincr
6917 write (2,*) "zz+ sumene from enesc=",sumenep
6918 costsave=cost2tab(i+1)
6919 sintsave=sint2tab(i+1)
6920 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6921 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6922 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6923 de_dt_num=(sumenep-sumene)/aincr
6924 write (2,*) " t+ sumene from enesc=",sumenep
6925 cost2tab(i+1)=costsave
6926 sint2tab(i+1)=sintsave
6927 C End of diagnostics section.
6930 C Compute the gradient of esc
6932 c zz=zz*dsign(1.0,dfloat(itype(i)))
6933 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6934 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6935 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6936 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6937 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6938 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6939 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6940 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6941 pom1=(sumene3*sint2tab(i+1)+sumene1)
6942 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6943 pom2=(sumene4*cost2tab(i+1)+sumene2)
6944 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6945 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6946 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6947 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6949 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6950 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6951 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6953 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6954 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6955 & +(pom1+pom2)*pom_dx
6957 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6960 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6961 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6962 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6964 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6965 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6966 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6967 & +x(59)*zz**2 +x(60)*xx*zz
6968 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6969 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6970 & +(pom1-pom2)*pom_dy
6972 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6975 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6976 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6977 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6978 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6979 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6980 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6981 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6982 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6984 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6987 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6988 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6989 & +pom1*pom_dt1+pom2*pom_dt2
6991 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6996 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6997 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6998 cosfac2xx=cosfac2*xx
6999 sinfac2yy=sinfac2*yy
7001 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
7003 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
7005 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
7006 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
7007 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
7008 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
7009 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
7010 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
7011 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
7012 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
7013 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
7014 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
7018 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
7019 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
7020 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
7021 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
7024 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
7025 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
7026 dZZ_XYZ(k)=vbld_inv(i+nres)*
7027 & (z_prime(k)-zz*dC_norm(k,i+nres))
7029 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
7030 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
7034 dXX_Ctab(k,i)=dXX_Ci(k)
7035 dXX_C1tab(k,i)=dXX_Ci1(k)
7036 dYY_Ctab(k,i)=dYY_Ci(k)
7037 dYY_C1tab(k,i)=dYY_Ci1(k)
7038 dZZ_Ctab(k,i)=dZZ_Ci(k)
7039 dZZ_C1tab(k,i)=dZZ_Ci1(k)
7040 dXX_XYZtab(k,i)=dXX_XYZ(k)
7041 dYY_XYZtab(k,i)=dYY_XYZ(k)
7042 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
7046 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
7047 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
7048 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
7049 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
7050 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
7052 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
7053 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
7054 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
7055 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
7056 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
7057 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
7058 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
7059 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
7061 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
7062 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
7064 C to check gradient call subroutine check_grad
7070 c------------------------------------------------------------------------------
7071 double precision function enesc(x,xx,yy,zz,cost2,sint2)
7073 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
7074 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
7075 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7076 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7078 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7079 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7081 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7082 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7083 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7084 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7085 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7087 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7088 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7089 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7090 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7091 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7093 dsc_i = 0.743d0+x(61)
7095 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7096 & *(xx*cost2+yy*sint2))
7097 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7098 & *(xx*cost2-yy*sint2))
7099 s1=(1+x(63))/(0.1d0 + dscp1)
7100 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7101 s2=(1+x(65))/(0.1d0 + dscp2)
7102 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7103 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
7104 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
7109 c------------------------------------------------------------------------------
7110 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
7112 C This procedure calculates two-body contact function g(rij) and its derivative:
7115 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
7118 C where x=(rij-r0ij)/delta
7120 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
7123 double precision rij,r0ij,eps0ij,fcont,fprimcont
7124 double precision x,x2,x4,delta
7128 if (x.lt.-1.0D0) then
7131 else if (x.le.1.0D0) then
7134 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
7135 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7142 c------------------------------------------------------------------------------
7143 subroutine splinthet(theti,delta,ss,ssder)
7144 implicit real*8 (a-h,o-z)
7145 include 'DIMENSIONS'
7146 include 'COMMON.VAR'
7147 include 'COMMON.GEO'
7150 if (theti.gt.pipol) then
7151 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7153 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7158 c------------------------------------------------------------------------------
7159 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7161 double precision x,x0,delta,f0,f1,fprim0,f,fprim
7162 double precision ksi,ksi2,ksi3,a1,a2,a3
7163 a1=fprim0*delta/(f1-f0)
7169 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7170 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7173 c------------------------------------------------------------------------------
7174 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7176 double precision x,x0,delta,f0x,f1x,fprim0x,fx
7177 double precision ksi,ksi2,ksi3,a1,a2,a3
7182 a2=3*(f1x-f0x)-2*fprim0x*delta
7183 a3=fprim0x*delta-2*(f1x-f0x)
7184 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7187 C-----------------------------------------------------------------------------
7189 C-----------------------------------------------------------------------------
7190 subroutine etor(etors,edihcnstr)
7191 implicit real*8 (a-h,o-z)
7192 include 'DIMENSIONS'
7193 include 'COMMON.VAR'
7194 include 'COMMON.GEO'
7195 include 'COMMON.LOCAL'
7196 include 'COMMON.TORSION'
7197 include 'COMMON.INTERACT'
7198 include 'COMMON.DERIV'
7199 include 'COMMON.CHAIN'
7200 include 'COMMON.NAMES'
7201 include 'COMMON.IOUNITS'
7202 include 'COMMON.FFIELD'
7203 include 'COMMON.TORCNSTR'
7204 include 'COMMON.CONTROL'
7206 C Set lprn=.true. for debugging
7210 do i=iphi_start,iphi_end
7212 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7213 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7214 itori=itortyp(itype(i-2))
7215 itori1=itortyp(itype(i-1))
7218 C Proline-Proline pair is a special case...
7219 if (itori.eq.3 .and. itori1.eq.3) then
7220 if (phii.gt.-dwapi3) then
7222 fac=1.0D0/(1.0D0-cosphi)
7223 etorsi=v1(1,3,3)*fac
7224 etorsi=etorsi+etorsi
7225 etors=etors+etorsi-v1(1,3,3)
7226 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
7227 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7230 v1ij=v1(j+1,itori,itori1)
7231 v2ij=v2(j+1,itori,itori1)
7234 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7235 if (energy_dec) etors_ii=etors_ii+
7236 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7237 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7241 v1ij=v1(j,itori,itori1)
7242 v2ij=v2(j,itori,itori1)
7245 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7246 if (energy_dec) etors_ii=etors_ii+
7247 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7248 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7251 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7254 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7255 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7256 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7257 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7258 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7260 ! 6/20/98 - dihedral angle constraints
7263 itori=idih_constr(i)
7266 if (difi.gt.drange(i)) then
7268 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7269 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7270 else if (difi.lt.-drange(i)) then
7272 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
7273 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7275 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
7276 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7278 ! write (iout,*) 'edihcnstr',edihcnstr
7281 c------------------------------------------------------------------------------
7282 subroutine etor_d(etors_d)
7286 c----------------------------------------------------------------------------
7288 subroutine etor(etors,edihcnstr)
7289 implicit real*8 (a-h,o-z)
7290 include 'DIMENSIONS'
7291 include 'COMMON.VAR'
7292 include 'COMMON.GEO'
7293 include 'COMMON.LOCAL'
7294 include 'COMMON.TORSION'
7295 include 'COMMON.INTERACT'
7296 include 'COMMON.DERIV'
7297 include 'COMMON.CHAIN'
7298 include 'COMMON.NAMES'
7299 include 'COMMON.IOUNITS'
7300 include 'COMMON.FFIELD'
7301 include 'COMMON.TORCNSTR'
7302 include 'COMMON.CONTROL'
7304 C Set lprn=.true. for debugging
7308 do i=iphi_start,iphi_end
7309 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7310 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7311 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7312 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7313 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7314 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7315 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7316 C For introducing the NH3+ and COO- group please check the etor_d for reference
7319 if (iabs(itype(i)).eq.20) then
7324 itori=itortyp(itype(i-2))
7325 itori1=itortyp(itype(i-1))
7328 C Regular cosine and sine terms
7329 do j=1,nterm(itori,itori1,iblock)
7330 v1ij=v1(j,itori,itori1,iblock)
7331 v2ij=v2(j,itori,itori1,iblock)
7334 etors=etors+v1ij*cosphi+v2ij*sinphi
7335 if (energy_dec) etors_ii=etors_ii+
7336 & v1ij*cosphi+v2ij*sinphi
7337 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7341 C E = SUM ----------------------------------- - v1
7342 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7344 cosphi=dcos(0.5d0*phii)
7345 sinphi=dsin(0.5d0*phii)
7346 do j=1,nlor(itori,itori1,iblock)
7347 vl1ij=vlor1(j,itori,itori1)
7348 vl2ij=vlor2(j,itori,itori1)
7349 vl3ij=vlor3(j,itori,itori1)
7350 pom=vl2ij*cosphi+vl3ij*sinphi
7351 pom1=1.0d0/(pom*pom+1.0d0)
7352 etors=etors+vl1ij*pom1
7353 if (energy_dec) etors_ii=etors_ii+
7356 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7358 C Subtract the constant term
7359 etors=etors-v0(itori,itori1,iblock)
7360 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7361 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
7363 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7364 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7365 & (v1(j,itori,itori1,iblock),j=1,6),
7366 & (v2(j,itori,itori1,iblock),j=1,6)
7367 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7368 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7370 ! 6/20/98 - dihedral angle constraints
7372 c do i=1,ndih_constr
7373 do i=idihconstr_start,idihconstr_end
7374 itori=idih_constr(i)
7376 difi=pinorm(phii-phi0(i))
7377 if (difi.gt.drange(i)) then
7379 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7380 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7381 else if (difi.lt.-drange(i)) then
7383 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7384 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7388 if (energy_dec) then
7389 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
7390 & i,itori,rad2deg*phii,
7391 & rad2deg*phi0(i), rad2deg*drange(i),
7392 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
7395 cd write (iout,*) 'edihcnstr',edihcnstr
7398 c----------------------------------------------------------------------------
7399 subroutine etor_d(etors_d)
7400 C 6/23/01 Compute double torsional energy
7401 implicit real*8 (a-h,o-z)
7402 include 'DIMENSIONS'
7403 include 'COMMON.VAR'
7404 include 'COMMON.GEO'
7405 include 'COMMON.LOCAL'
7406 include 'COMMON.TORSION'
7407 include 'COMMON.INTERACT'
7408 include 'COMMON.DERIV'
7409 include 'COMMON.CHAIN'
7410 include 'COMMON.NAMES'
7411 include 'COMMON.IOUNITS'
7412 include 'COMMON.FFIELD'
7413 include 'COMMON.TORCNSTR'
7415 C Set lprn=.true. for debugging
7419 c write(iout,*) "a tu??"
7420 do i=iphid_start,iphid_end
7421 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7422 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7423 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7424 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7425 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7426 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7427 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7428 & (itype(i+1).eq.ntyp1)) cycle
7429 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7430 itori=itortyp(itype(i-2))
7431 itori1=itortyp(itype(i-1))
7432 itori2=itortyp(itype(i))
7438 if (iabs(itype(i+1)).eq.20) iblock=2
7439 C Iblock=2 Proline type
7440 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7441 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7442 C if (itype(i+1).eq.ntyp1) iblock=3
7443 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7444 C IS or IS NOT need for this
7445 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7446 C is (itype(i-3).eq.ntyp1) ntblock=2
7447 C ntblock is N-terminal blocking group
7449 C Regular cosine and sine terms
7450 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7451 C Example of changes for NH3+ blocking group
7452 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7453 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7454 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7455 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7456 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7457 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7458 cosphi1=dcos(j*phii)
7459 sinphi1=dsin(j*phii)
7460 cosphi2=dcos(j*phii1)
7461 sinphi2=dsin(j*phii1)
7462 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7463 & v2cij*cosphi2+v2sij*sinphi2
7464 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7465 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7467 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7469 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7470 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7471 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7472 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7473 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7474 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7475 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7476 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7477 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7478 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7479 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7480 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7481 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7482 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7485 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7486 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7491 C----------------------------------------------------------------------------------
7492 C The rigorous attempt to derive energy function
7493 subroutine etor_kcc(etors,edihcnstr)
7494 implicit real*8 (a-h,o-z)
7495 include 'DIMENSIONS'
7496 include 'COMMON.VAR'
7497 include 'COMMON.GEO'
7498 include 'COMMON.LOCAL'
7499 include 'COMMON.TORSION'
7500 include 'COMMON.INTERACT'
7501 include 'COMMON.DERIV'
7502 include 'COMMON.CHAIN'
7503 include 'COMMON.NAMES'
7504 include 'COMMON.IOUNITS'
7505 include 'COMMON.FFIELD'
7506 include 'COMMON.TORCNSTR'
7507 include 'COMMON.CONTROL'
7509 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
7510 C Set lprn=.true. for debugging
7513 C print *,"wchodze kcc"
7514 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
7515 if (tor_mode.ne.2) then
7518 do i=iphi_start,iphi_end
7519 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7520 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7521 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7522 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7523 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7524 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7525 itori=itortyp_kcc(itype(i-2))
7526 itori1=itortyp_kcc(itype(i-1))
7531 sumnonchebyshev=0.0d0
7533 C to avoid multiple devision by 2
7534 c theti22=0.5d0*theta(i)
7535 C theta 12 is the theta_1 /2
7536 C theta 22 is theta_2 /2
7537 c theti12=0.5d0*theta(i-1)
7538 C and appropriate sinus function
7539 sinthet1=dsin(theta(i-1))
7540 sinthet2=dsin(theta(i))
7541 costhet1=dcos(theta(i-1))
7542 costhet2=dcos(theta(i))
7543 c Cosines of halves thetas
7544 costheti12=0.5d0*(1.0d0+costhet1)
7545 costheti22=0.5d0*(1.0d0+costhet2)
7546 C to speed up lets store its mutliplication
7547 sint1t2=sinthet2*sinthet1
7549 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
7550 C +d_n*sin(n*gamma)) *
7551 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
7552 C we have two sum 1) Non-Chebyshev which is with n and gamma
7554 do j=1,nterm_kcc(itori,itori1)
7556 nval=nterm_kcc_Tb(itori,itori1)
7557 v1ij=v1_kcc(j,itori,itori1)
7558 v2ij=v2_kcc(j,itori,itori1)
7559 c write (iout,*) "i",i," j",j," v1",v1ij," v2",v2ij
7560 C v1ij is c_n and d_n in euation above
7564 sint1t2n=sint1t2n*sint1t2
7565 sumth1tyb1=tschebyshev(1,nval,v11_chyb(1,j,itori,itori1),
7567 gradth1tyb1=-0.5d0*sinthet1*gradtschebyshev(0,nval-1,
7568 & v11_chyb(1,j,itori,itori1),costheti12)
7569 c write (iout,*) "v11",(v11_chyb(k,j,itori,itori1),k=1,nval),
7570 c & " sumth1tyb1",sumth1tyb1," gradth1tyb1",gradth1tyb1
7571 sumth2tyb1=tschebyshev(1,nval,v21_chyb(1,j,itori,itori1),
7573 gradth2tyb1=-0.5d0*sinthet2*gradtschebyshev(0,nval-1,
7574 & v21_chyb(1,j,itori,itori1),costheti22)
7575 c write (iout,*) "v21",(v21_chyb(k,j,itori,itori1),k=1,nval),
7576 c & " sumth2tyb1",sumth2tyb1," gradth2tyb1",gradth2tyb1
7577 sumth1tyb2=tschebyshev(1,nval,v12_chyb(1,j,itori,itori1),
7579 gradth1tyb2=-0.5d0*sinthet1*gradtschebyshev(0,nval-1,
7580 & v12_chyb(1,j,itori,itori1),costheti12)
7581 c write (iout,*) "v12",(v12_chyb(k,j,itori,itori1),k=1,nval),
7582 c & " sumth1tyb2",sumth1tyb2," gradth1tyb2",gradth1tyb2
7583 sumth2tyb2=tschebyshev(1,nval,v22_chyb(1,j,itori,itori1),
7585 gradth2tyb2=-0.5d0*sinthet2*gradtschebyshev(0,nval-1,
7586 & v22_chyb(1,j,itori,itori1),costheti22)
7587 c write (iout,*) "v22",(v22_chyb(k,j,itori,itori1),k=1,nval),
7588 c & " sumth2tyb2",sumth2tyb2," gradth2tyb2",gradth2tyb2
7589 C etors=etors+sint1t2n*(v1ij*cosphi+v2ij*sinphi)
7590 C if (energy_dec) etors_ii=etors_ii+
7591 C & v1ij*cosphi+v2ij*sinphi
7592 C glocig is the gradient local i site in gamma
7593 actval1=v1ij*cosphi*(1.0d0+sumth1tyb1+sumth2tyb1)
7594 actval2=v2ij*sinphi*(1.0d0+sumth1tyb2+sumth2tyb2)
7595 etori=etori+sint1t2n*(actval1+actval2)
7597 & j*sint1t2n*(v2ij*cosphi*(1.0d0+sumth1tyb2+sumth2tyb2)
7598 & -v1ij*sinphi*(1.0d0+sumth1tyb1+sumth2tyb1))
7599 C now gradient over theta_1
7601 & j*sint1t2n1*costhet1*sinthet2*(actval1+actval2)+
7602 & sint1t2n*(v1ij*cosphi*gradth1tyb1+v2ij*sinphi*gradth1tyb2)
7604 & j*sint1t2n1*sinthet1*costhet2*(actval1+actval2)+
7605 & sint1t2n*(v1ij*cosphi*gradth2tyb1+v2ij*sinphi*gradth2tyb2)
7607 C now the Czebyshev polinominal sum
7608 c do k=1,nterm_kcc_Tb(itori,itori1)
7609 c thybt1(k)=v1_chyb(k,j,itori,itori1)
7610 c thybt2(k)=v2_chyb(k,j,itori,itori1)
7614 C print *, sumth1thyb, gradthybt1, sumth2thyb, gradthybt2,
7616 C & (0,nterm_kcc_Tb(itori,itori1)-1,thybt2(1),
7617 C & dcos(theti22)**2),
7620 C now overal sumation
7621 C print *,"sumnon", sumnonchebyshev,sumth1thyb+sumth2thyb
7624 C derivative over gamma
7625 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
7626 C derivative over theta1
7627 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
7628 C now derivative over theta2
7629 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
7631 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
7632 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
7634 C gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7635 ! 6/20/98 - dihedral angle constraints
7636 if (tor_mode.ne.2) then
7638 c do i=1,ndih_constr
7639 do i=idihconstr_start,idihconstr_end
7640 itori=idih_constr(i)
7642 difi=pinorm(phii-phi0(i))
7643 if (difi.gt.drange(i)) then
7645 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7646 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7647 else if (difi.lt.-drange(i)) then
7649 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7650 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7659 C The rigorous attempt to derive energy function
7660 subroutine ebend_kcc(etheta,ethetacnstr)
7662 implicit real*8 (a-h,o-z)
7663 include 'DIMENSIONS'
7664 include 'COMMON.VAR'
7665 include 'COMMON.GEO'
7666 include 'COMMON.LOCAL'
7667 include 'COMMON.TORSION'
7668 include 'COMMON.INTERACT'
7669 include 'COMMON.DERIV'
7670 include 'COMMON.CHAIN'
7671 include 'COMMON.NAMES'
7672 include 'COMMON.IOUNITS'
7673 include 'COMMON.FFIELD'
7674 include 'COMMON.TORCNSTR'
7675 include 'COMMON.CONTROL'
7677 double precision thybt1(maxtermkcc)
7678 C Set lprn=.true. for debugging
7681 C print *,"wchodze kcc"
7682 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
7683 if (tor_mode.ne.2) etheta=0.0D0
7684 do i=ithet_start,ithet_end
7685 c print *,i,itype(i-1),itype(i),itype(i-2)
7686 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
7687 & .or.itype(i).eq.ntyp1) cycle
7688 iti=itortyp_kcc(itype(i-1))
7689 sinthet=dsin(theta(i)/2.0d0)
7690 costhet=dcos(theta(i)/2.0d0)
7691 do j=1,nbend_kcc_Tb(iti)
7692 thybt1(j)=v1bend_chyb(j,iti)
7694 sumth1thyb=tschebyshev
7695 & (1,nbend_kcc_Tb(iti),thybt1(1),costhet)
7696 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
7698 ihelp=nbend_kcc_Tb(iti)-1
7699 gradthybt1=gradtschebyshev
7700 & (0,ihelp,thybt1(1),costhet)
7701 etheta=etheta+sumth1thyb
7702 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
7703 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*
7704 & gradthybt1*sinthet*(-0.5d0)
7706 if (tor_mode.ne.2) then
7708 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
7709 do i=ithetaconstr_start,ithetaconstr_end
7710 itheta=itheta_constr(i)
7711 thetiii=theta(itheta)
7712 difi=pinorm(thetiii-theta_constr0(i))
7713 if (difi.gt.theta_drange(i)) then
7714 difi=difi-theta_drange(i)
7715 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7716 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7717 & +for_thet_constr(i)*difi**3
7718 else if (difi.lt.-drange(i)) then
7720 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7721 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7722 & +for_thet_constr(i)*difi**3
7726 if (energy_dec) then
7727 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
7728 & i,itheta,rad2deg*thetiii,
7729 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
7730 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
7731 & gloc(itheta+nphi-2,icg)
7737 c------------------------------------------------------------------------------
7738 subroutine eback_sc_corr(esccor)
7739 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7740 c conformational states; temporarily implemented as differences
7741 c between UNRES torsional potentials (dependent on three types of
7742 c residues) and the torsional potentials dependent on all 20 types
7743 c of residues computed from AM1 energy surfaces of terminally-blocked
7744 c amino-acid residues.
7745 implicit real*8 (a-h,o-z)
7746 include 'DIMENSIONS'
7747 include 'COMMON.VAR'
7748 include 'COMMON.GEO'
7749 include 'COMMON.LOCAL'
7750 include 'COMMON.TORSION'
7751 include 'COMMON.SCCOR'
7752 include 'COMMON.INTERACT'
7753 include 'COMMON.DERIV'
7754 include 'COMMON.CHAIN'
7755 include 'COMMON.NAMES'
7756 include 'COMMON.IOUNITS'
7757 include 'COMMON.FFIELD'
7758 include 'COMMON.CONTROL'
7760 C Set lprn=.true. for debugging
7763 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7765 do i=itau_start,itau_end
7766 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7768 isccori=isccortyp(itype(i-2))
7769 isccori1=isccortyp(itype(i-1))
7770 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7772 do intertyp=1,3 !intertyp
7773 cc Added 09 May 2012 (Adasko)
7774 cc Intertyp means interaction type of backbone mainchain correlation:
7775 c 1 = SC...Ca...Ca...Ca
7776 c 2 = Ca...Ca...Ca...SC
7777 c 3 = SC...Ca...Ca...SCi
7779 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7780 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7781 & (itype(i-1).eq.ntyp1)))
7782 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7783 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7784 & .or.(itype(i).eq.ntyp1)))
7785 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7786 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7787 & (itype(i-3).eq.ntyp1)))) cycle
7788 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7789 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7791 do j=1,nterm_sccor(isccori,isccori1)
7792 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7793 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7794 cosphi=dcos(j*tauangle(intertyp,i))
7795 sinphi=dsin(j*tauangle(intertyp,i))
7796 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7797 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7799 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7800 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7802 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7803 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
7804 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
7805 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7806 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7812 c----------------------------------------------------------------------------
7813 subroutine multibody(ecorr)
7814 C This subroutine calculates multi-body contributions to energy following
7815 C the idea of Skolnick et al. If side chains I and J make a contact and
7816 C at the same time side chains I+1 and J+1 make a contact, an extra
7817 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7818 implicit real*8 (a-h,o-z)
7819 include 'DIMENSIONS'
7820 include 'COMMON.IOUNITS'
7821 include 'COMMON.DERIV'
7822 include 'COMMON.INTERACT'
7823 include 'COMMON.CONTACTS'
7824 double precision gx(3),gx1(3)
7827 C Set lprn=.true. for debugging
7831 write (iout,'(a)') 'Contact function values:'
7833 write (iout,'(i2,20(1x,i2,f10.5))')
7834 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7849 num_conti=num_cont(i)
7850 num_conti1=num_cont(i1)
7855 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7856 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7857 cd & ' ishift=',ishift
7858 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7859 C The system gains extra energy.
7860 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7861 endif ! j1==j+-ishift
7870 c------------------------------------------------------------------------------
7871 double precision function esccorr(i,j,k,l,jj,kk)
7872 implicit real*8 (a-h,o-z)
7873 include 'DIMENSIONS'
7874 include 'COMMON.IOUNITS'
7875 include 'COMMON.DERIV'
7876 include 'COMMON.INTERACT'
7877 include 'COMMON.CONTACTS'
7878 include 'COMMON.SHIELD'
7879 double precision gx(3),gx1(3)
7884 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7885 C Calculate the multi-body contribution to energy.
7886 C Calculate multi-body contributions to the gradient.
7887 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7888 cd & k,l,(gacont(m,kk,k),m=1,3)
7890 gx(m) =ekl*gacont(m,jj,i)
7891 gx1(m)=eij*gacont(m,kk,k)
7892 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7893 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7894 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7895 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7899 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7904 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7910 c------------------------------------------------------------------------------
7911 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7912 C This subroutine calculates multi-body contributions to hydrogen-bonding
7913 implicit real*8 (a-h,o-z)
7914 include 'DIMENSIONS'
7915 include 'COMMON.IOUNITS'
7918 parameter (max_cont=maxconts)
7919 parameter (max_dim=26)
7920 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7921 double precision zapas(max_dim,maxconts,max_fg_procs),
7922 & zapas_recv(max_dim,maxconts,max_fg_procs)
7923 common /przechowalnia/ zapas
7924 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7925 & status_array(MPI_STATUS_SIZE,maxconts*2)
7927 include 'COMMON.SETUP'
7928 include 'COMMON.FFIELD'
7929 include 'COMMON.DERIV'
7930 include 'COMMON.INTERACT'
7931 include 'COMMON.CONTACTS'
7932 include 'COMMON.CONTROL'
7933 include 'COMMON.LOCAL'
7934 double precision gx(3),gx1(3),time00
7937 C Set lprn=.true. for debugging
7942 if (nfgtasks.le.1) goto 30
7944 write (iout,'(a)') 'Contact function values before RECEIVE:'
7946 write (iout,'(2i3,50(1x,i2,f5.2))')
7947 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7948 & j=1,num_cont_hb(i))
7952 do i=1,ntask_cont_from
7955 do i=1,ntask_cont_to
7958 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7960 C Make the list of contacts to send to send to other procesors
7961 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7963 do i=iturn3_start,iturn3_end
7964 c write (iout,*) "make contact list turn3",i," num_cont",
7966 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7968 do i=iturn4_start,iturn4_end
7969 c write (iout,*) "make contact list turn4",i," num_cont",
7971 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7975 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7977 do j=1,num_cont_hb(i)
7980 iproc=iint_sent_local(k,jjc,ii)
7981 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7982 if (iproc.gt.0) then
7983 ncont_sent(iproc)=ncont_sent(iproc)+1
7984 nn=ncont_sent(iproc)
7986 zapas(2,nn,iproc)=jjc
7987 zapas(3,nn,iproc)=facont_hb(j,i)
7988 zapas(4,nn,iproc)=ees0p(j,i)
7989 zapas(5,nn,iproc)=ees0m(j,i)
7990 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7991 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7992 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7993 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7994 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7995 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7996 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7997 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7998 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7999 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
8000 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
8001 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
8002 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
8003 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
8004 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
8005 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
8006 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
8007 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
8008 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
8009 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
8010 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
8017 & "Numbers of contacts to be sent to other processors",
8018 & (ncont_sent(i),i=1,ntask_cont_to)
8019 write (iout,*) "Contacts sent"
8020 do ii=1,ntask_cont_to
8022 iproc=itask_cont_to(ii)
8023 write (iout,*) nn," contacts to processor",iproc,
8024 & " of CONT_TO_COMM group"
8026 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8034 CorrelID1=nfgtasks+fg_rank+1
8036 C Receive the numbers of needed contacts from other processors
8037 do ii=1,ntask_cont_from
8038 iproc=itask_cont_from(ii)
8040 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8041 & FG_COMM,req(ireq),IERR)
8043 c write (iout,*) "IRECV ended"
8045 C Send the number of contacts needed by other processors
8046 do ii=1,ntask_cont_to
8047 iproc=itask_cont_to(ii)
8049 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8050 & FG_COMM,req(ireq),IERR)
8052 c write (iout,*) "ISEND ended"
8053 c write (iout,*) "number of requests (nn)",ireq
8056 & call MPI_Waitall(ireq,req,status_array,ierr)
8058 c & "Numbers of contacts to be received from other processors",
8059 c & (ncont_recv(i),i=1,ntask_cont_from)
8063 do ii=1,ntask_cont_from
8064 iproc=itask_cont_from(ii)
8066 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8067 c & " of CONT_TO_COMM group"
8071 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8072 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8073 c write (iout,*) "ireq,req",ireq,req(ireq)
8076 C Send the contacts to processors that need them
8077 do ii=1,ntask_cont_to
8078 iproc=itask_cont_to(ii)
8080 c write (iout,*) nn," contacts to processor",iproc,
8081 c & " of CONT_TO_COMM group"
8084 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8085 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8086 c write (iout,*) "ireq,req",ireq,req(ireq)
8088 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8092 c write (iout,*) "number of requests (contacts)",ireq
8093 c write (iout,*) "req",(req(i),i=1,4)
8096 & call MPI_Waitall(ireq,req,status_array,ierr)
8097 do iii=1,ntask_cont_from
8098 iproc=itask_cont_from(iii)
8101 write (iout,*) "Received",nn," contacts from processor",iproc,
8102 & " of CONT_FROM_COMM group"
8105 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8110 ii=zapas_recv(1,i,iii)
8111 c Flag the received contacts to prevent double-counting
8112 jj=-zapas_recv(2,i,iii)
8113 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8115 nnn=num_cont_hb(ii)+1
8118 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8119 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8120 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8121 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8122 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8123 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8124 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8125 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8126 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8127 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8128 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8129 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8130 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8131 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8132 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8133 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8134 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8135 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8136 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8137 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8138 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8139 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8140 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8141 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8146 write (iout,'(a)') 'Contact function values after receive:'
8148 write (iout,'(2i3,50(1x,i3,f5.2))')
8149 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8150 & j=1,num_cont_hb(i))
8157 write (iout,'(a)') 'Contact function values:'
8159 write (iout,'(2i3,50(1x,i3,f5.2))')
8160 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8161 & j=1,num_cont_hb(i))
8165 C Remove the loop below after debugging !!!
8172 C Calculate the local-electrostatic correlation terms
8173 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8175 num_conti=num_cont_hb(i)
8176 num_conti1=num_cont_hb(i+1)
8183 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8184 c & ' jj=',jj,' kk=',kk
8185 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8186 & .or. j.lt.0 .and. j1.gt.0) .and.
8187 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8188 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8189 C The system gains extra energy.
8190 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8191 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
8192 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
8194 else if (j1.eq.j) then
8195 C Contacts I-J and I-(J+1) occur simultaneously.
8196 C The system loses extra energy.
8197 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8202 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8203 c & ' jj=',jj,' kk=',kk
8205 C Contacts I-J and (I+1)-J occur simultaneously.
8206 C The system loses extra energy.
8207 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8214 c------------------------------------------------------------------------------
8215 subroutine add_hb_contact(ii,jj,itask)
8216 implicit real*8 (a-h,o-z)
8217 include "DIMENSIONS"
8218 include "COMMON.IOUNITS"
8221 parameter (max_cont=maxconts)
8222 parameter (max_dim=26)
8223 include "COMMON.CONTACTS"
8224 double precision zapas(max_dim,maxconts,max_fg_procs),
8225 & zapas_recv(max_dim,maxconts,max_fg_procs)
8226 common /przechowalnia/ zapas
8227 integer i,j,ii,jj,iproc,itask(4),nn
8228 c write (iout,*) "itask",itask
8231 if (iproc.gt.0) then
8232 do j=1,num_cont_hb(ii)
8234 c write (iout,*) "i",ii," j",jj," jjc",jjc
8236 ncont_sent(iproc)=ncont_sent(iproc)+1
8237 nn=ncont_sent(iproc)
8238 zapas(1,nn,iproc)=ii
8239 zapas(2,nn,iproc)=jjc
8240 zapas(3,nn,iproc)=facont_hb(j,ii)
8241 zapas(4,nn,iproc)=ees0p(j,ii)
8242 zapas(5,nn,iproc)=ees0m(j,ii)
8243 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8244 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8245 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8246 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8247 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8248 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8249 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8250 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8251 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8252 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8253 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8254 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8255 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8256 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8257 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8258 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8259 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8260 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8261 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8262 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8263 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8271 c------------------------------------------------------------------------------
8272 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8274 C This subroutine calculates multi-body contributions to hydrogen-bonding
8275 implicit real*8 (a-h,o-z)
8276 include 'DIMENSIONS'
8277 include 'COMMON.IOUNITS'
8280 parameter (max_cont=maxconts)
8281 parameter (max_dim=70)
8282 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8283 double precision zapas(max_dim,maxconts,max_fg_procs),
8284 & zapas_recv(max_dim,maxconts,max_fg_procs)
8285 common /przechowalnia/ zapas
8286 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8287 & status_array(MPI_STATUS_SIZE,maxconts*2)
8289 include 'COMMON.SETUP'
8290 include 'COMMON.FFIELD'
8291 include 'COMMON.DERIV'
8292 include 'COMMON.LOCAL'
8293 include 'COMMON.INTERACT'
8294 include 'COMMON.CONTACTS'
8295 include 'COMMON.CHAIN'
8296 include 'COMMON.CONTROL'
8297 include 'COMMON.SHIELD'
8298 double precision gx(3),gx1(3)
8299 integer num_cont_hb_old(maxres)
8301 double precision eello4,eello5,eelo6,eello_turn6
8302 external eello4,eello5,eello6,eello_turn6
8303 C Set lprn=.true. for debugging
8308 num_cont_hb_old(i)=num_cont_hb(i)
8312 if (nfgtasks.le.1) goto 30
8314 write (iout,'(a)') 'Contact function values before RECEIVE:'
8316 write (iout,'(2i3,50(1x,i2,f5.2))')
8317 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8318 & j=1,num_cont_hb(i))
8322 do i=1,ntask_cont_from
8325 do i=1,ntask_cont_to
8328 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8330 C Make the list of contacts to send to send to other procesors
8331 do i=iturn3_start,iturn3_end
8332 c write (iout,*) "make contact list turn3",i," num_cont",
8334 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8336 do i=iturn4_start,iturn4_end
8337 c write (iout,*) "make contact list turn4",i," num_cont",
8339 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8343 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8345 do j=1,num_cont_hb(i)
8348 iproc=iint_sent_local(k,jjc,ii)
8349 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8350 if (iproc.ne.0) then
8351 ncont_sent(iproc)=ncont_sent(iproc)+1
8352 nn=ncont_sent(iproc)
8354 zapas(2,nn,iproc)=jjc
8355 zapas(3,nn,iproc)=d_cont(j,i)
8359 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8364 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8372 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8383 & "Numbers of contacts to be sent to other processors",
8384 & (ncont_sent(i),i=1,ntask_cont_to)
8385 write (iout,*) "Contacts sent"
8386 do ii=1,ntask_cont_to
8388 iproc=itask_cont_to(ii)
8389 write (iout,*) nn," contacts to processor",iproc,
8390 & " of CONT_TO_COMM group"
8392 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8400 CorrelID1=nfgtasks+fg_rank+1
8402 C Receive the numbers of needed contacts from other processors
8403 do ii=1,ntask_cont_from
8404 iproc=itask_cont_from(ii)
8406 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8407 & FG_COMM,req(ireq),IERR)
8409 c write (iout,*) "IRECV ended"
8411 C Send the number of contacts needed by other processors
8412 do ii=1,ntask_cont_to
8413 iproc=itask_cont_to(ii)
8415 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8416 & FG_COMM,req(ireq),IERR)
8418 c write (iout,*) "ISEND ended"
8419 c write (iout,*) "number of requests (nn)",ireq
8422 & call MPI_Waitall(ireq,req,status_array,ierr)
8424 c & "Numbers of contacts to be received from other processors",
8425 c & (ncont_recv(i),i=1,ntask_cont_from)
8429 do ii=1,ntask_cont_from
8430 iproc=itask_cont_from(ii)
8432 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8433 c & " of CONT_TO_COMM group"
8437 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8438 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8439 c write (iout,*) "ireq,req",ireq,req(ireq)
8442 C Send the contacts to processors that need them
8443 do ii=1,ntask_cont_to
8444 iproc=itask_cont_to(ii)
8446 c write (iout,*) nn," contacts to processor",iproc,
8447 c & " of CONT_TO_COMM group"
8450 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8451 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8452 c write (iout,*) "ireq,req",ireq,req(ireq)
8454 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8458 c write (iout,*) "number of requests (contacts)",ireq
8459 c write (iout,*) "req",(req(i),i=1,4)
8462 & call MPI_Waitall(ireq,req,status_array,ierr)
8463 do iii=1,ntask_cont_from
8464 iproc=itask_cont_from(iii)
8467 write (iout,*) "Received",nn," contacts from processor",iproc,
8468 & " of CONT_FROM_COMM group"
8471 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8476 ii=zapas_recv(1,i,iii)
8477 c Flag the received contacts to prevent double-counting
8478 jj=-zapas_recv(2,i,iii)
8479 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8481 nnn=num_cont_hb(ii)+1
8484 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8488 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8493 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8501 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8510 write (iout,'(a)') 'Contact function values after receive:'
8512 write (iout,'(2i3,50(1x,i3,5f6.3))')
8513 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8514 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8521 write (iout,'(a)') 'Contact function values:'
8523 write (iout,'(2i3,50(1x,i2,5f6.3))')
8524 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8525 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8531 C Remove the loop below after debugging !!!
8538 C Calculate the dipole-dipole interaction energies
8539 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8540 do i=iatel_s,iatel_e+1
8541 num_conti=num_cont_hb(i)
8550 C Calculate the local-electrostatic correlation terms
8551 c write (iout,*) "gradcorr5 in eello5 before loop"
8553 c write (iout,'(i5,3f10.5)')
8554 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8556 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8557 c write (iout,*) "corr loop i",i
8559 num_conti=num_cont_hb(i)
8560 num_conti1=num_cont_hb(i+1)
8567 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8568 c & ' jj=',jj,' kk=',kk
8569 c if (j1.eq.j+1 .or. j1.eq.j-1) then
8570 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8571 & .or. j.lt.0 .and. j1.gt.0) .and.
8572 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8573 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8574 C The system gains extra energy.
8576 sqd1=dsqrt(d_cont(jj,i))
8577 sqd2=dsqrt(d_cont(kk,i1))
8578 sred_geom = sqd1*sqd2
8579 IF (sred_geom.lt.cutoff_corr) THEN
8580 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
8582 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8583 cd & ' jj=',jj,' kk=',kk
8584 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8585 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8587 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8588 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8591 cd write (iout,*) 'sred_geom=',sred_geom,
8592 cd & ' ekont=',ekont,' fprim=',fprimcont,
8593 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8594 cd write (iout,*) "g_contij",g_contij
8595 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8596 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8597 call calc_eello(i,jp,i+1,jp1,jj,kk)
8598 if (wcorr4.gt.0.0d0)
8599 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8600 CC & *fac_shield(i)**2*fac_shield(j)**2
8601 if (energy_dec.and.wcorr4.gt.0.0d0)
8602 1 write (iout,'(a6,4i5,0pf7.3)')
8603 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8604 c write (iout,*) "gradcorr5 before eello5"
8606 c write (iout,'(i5,3f10.5)')
8607 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8609 if (wcorr5.gt.0.0d0)
8610 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8611 c write (iout,*) "gradcorr5 after eello5"
8613 c write (iout,'(i5,3f10.5)')
8614 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8616 if (energy_dec.and.wcorr5.gt.0.0d0)
8617 1 write (iout,'(a6,4i5,0pf7.3)')
8618 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8619 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8620 cd write(2,*)'ijkl',i,jp,i+1,jp1
8621 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
8622 & .or. wturn6.eq.0.0d0))then
8623 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8624 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8625 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8626 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8627 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8628 cd & 'ecorr6=',ecorr6
8629 cd write (iout,'(4e15.5)') sred_geom,
8630 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8631 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8632 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8633 else if (wturn6.gt.0.0d0
8634 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8635 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8636 eturn6=eturn6+eello_turn6(i,jj,kk)
8637 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8638 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8639 cd write (2,*) 'multibody_eello:eturn6',eturn6
8648 num_cont_hb(i)=num_cont_hb_old(i)
8650 c write (iout,*) "gradcorr5 in eello5"
8652 c write (iout,'(i5,3f10.5)')
8653 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8657 c------------------------------------------------------------------------------
8658 subroutine add_hb_contact_eello(ii,jj,itask)
8659 implicit real*8 (a-h,o-z)
8660 include "DIMENSIONS"
8661 include "COMMON.IOUNITS"
8664 parameter (max_cont=maxconts)
8665 parameter (max_dim=70)
8666 include "COMMON.CONTACTS"
8667 double precision zapas(max_dim,maxconts,max_fg_procs),
8668 & zapas_recv(max_dim,maxconts,max_fg_procs)
8669 common /przechowalnia/ zapas
8670 integer i,j,ii,jj,iproc,itask(4),nn
8671 c write (iout,*) "itask",itask
8674 if (iproc.gt.0) then
8675 do j=1,num_cont_hb(ii)
8677 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8679 ncont_sent(iproc)=ncont_sent(iproc)+1
8680 nn=ncont_sent(iproc)
8681 zapas(1,nn,iproc)=ii
8682 zapas(2,nn,iproc)=jjc
8683 zapas(3,nn,iproc)=d_cont(j,ii)
8687 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8692 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8700 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8712 c------------------------------------------------------------------------------
8713 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8714 implicit real*8 (a-h,o-z)
8715 include 'DIMENSIONS'
8716 include 'COMMON.IOUNITS'
8717 include 'COMMON.DERIV'
8718 include 'COMMON.INTERACT'
8719 include 'COMMON.CONTACTS'
8720 include 'COMMON.SHIELD'
8721 include 'COMMON.CONTROL'
8722 double precision gx(3),gx1(3)
8725 C print *,"wchodze",fac_shield(i),shield_mode
8733 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8735 C & fac_shield(i)**2*fac_shield(j)**2
8736 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8737 C Following 4 lines for diagnostics.
8742 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8743 c & 'Contacts ',i,j,
8744 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8745 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8747 C Calculate the multi-body contribution to energy.
8748 C ecorr=ecorr+ekont*ees
8749 C Calculate multi-body contributions to the gradient.
8750 coeffpees0pij=coeffp*ees0pij
8751 coeffmees0mij=coeffm*ees0mij
8752 coeffpees0pkl=coeffp*ees0pkl
8753 coeffmees0mkl=coeffm*ees0mkl
8755 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8756 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8757 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8758 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8759 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8760 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8761 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8762 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8763 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8764 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8765 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8766 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8767 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8768 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8769 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8770 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8771 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8772 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8773 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8774 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8775 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8776 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8777 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8778 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8779 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8784 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8785 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8786 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8787 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8792 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8793 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8794 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8795 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8798 c write (iout,*) "ehbcorr",ekont*ees
8799 C print *,ekont,ees,i,k
8801 C now gradient over shielding
8803 if (shield_mode.gt.0) then
8806 C print *,i,j,fac_shield(i),fac_shield(j),
8807 C &fac_shield(k),fac_shield(l)
8808 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
8809 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8810 do ilist=1,ishield_list(i)
8811 iresshield=shield_list(ilist,i)
8813 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8815 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8817 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8818 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8822 do ilist=1,ishield_list(j)
8823 iresshield=shield_list(ilist,j)
8825 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8827 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8829 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8830 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8835 do ilist=1,ishield_list(k)
8836 iresshield=shield_list(ilist,k)
8838 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8840 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8842 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8843 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8847 do ilist=1,ishield_list(l)
8848 iresshield=shield_list(ilist,l)
8850 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8852 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8854 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8855 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8859 C print *,gshieldx(m,iresshield)
8861 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
8862 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8863 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
8864 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8865 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
8866 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8867 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
8868 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8870 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
8871 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8872 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
8873 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8874 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
8875 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8876 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
8877 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8885 C---------------------------------------------------------------------------
8886 subroutine dipole(i,j,jj)
8887 implicit real*8 (a-h,o-z)
8888 include 'DIMENSIONS'
8889 include 'COMMON.IOUNITS'
8890 include 'COMMON.CHAIN'
8891 include 'COMMON.FFIELD'
8892 include 'COMMON.DERIV'
8893 include 'COMMON.INTERACT'
8894 include 'COMMON.CONTACTS'
8895 include 'COMMON.TORSION'
8896 include 'COMMON.VAR'
8897 include 'COMMON.GEO'
8898 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8900 iti1 = itortyp(itype(i+1))
8901 if (j.lt.nres-1) then
8902 itj1 = itype2loc(itype(j+1))
8907 dipi(iii,1)=Ub2(iii,i)
8908 dipderi(iii)=Ub2der(iii,i)
8909 dipi(iii,2)=b1(iii,i+1)
8910 dipj(iii,1)=Ub2(iii,j)
8911 dipderj(iii)=Ub2der(iii,j)
8912 dipj(iii,2)=b1(iii,j+1)
8916 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8919 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8926 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8930 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8935 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8936 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8938 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8940 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8942 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8947 C---------------------------------------------------------------------------
8948 subroutine calc_eello(i,j,k,l,jj,kk)
8950 C This subroutine computes matrices and vectors needed to calculate
8951 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8953 implicit real*8 (a-h,o-z)
8954 include 'DIMENSIONS'
8955 include 'COMMON.IOUNITS'
8956 include 'COMMON.CHAIN'
8957 include 'COMMON.DERIV'
8958 include 'COMMON.INTERACT'
8959 include 'COMMON.CONTACTS'
8960 include 'COMMON.TORSION'
8961 include 'COMMON.VAR'
8962 include 'COMMON.GEO'
8963 include 'COMMON.FFIELD'
8964 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8965 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8968 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8969 cd & ' jj=',jj,' kk=',kk
8970 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8971 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8972 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8975 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8976 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8979 call transpose2(aa1(1,1),aa1t(1,1))
8980 call transpose2(aa2(1,1),aa2t(1,1))
8983 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8984 & aa1tder(1,1,lll,kkk))
8985 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8986 & aa2tder(1,1,lll,kkk))
8990 C parallel orientation of the two CA-CA-CA frames.
8992 iti=itype2loc(itype(i))
8996 itk1=itype2loc(itype(k+1))
8997 itj=itype2loc(itype(j))
8998 if (l.lt.nres-1) then
8999 itl1=itype2loc(itype(l+1))
9003 C A1 kernel(j+1) A2T
9005 cd write (iout,'(3f10.5,5x,3f10.5)')
9006 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
9008 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9009 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
9010 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9011 C Following matrices are needed only for 6-th order cumulants
9012 IF (wcorr6.gt.0.0d0) THEN
9013 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9014 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
9015 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9016 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9017 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
9018 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9019 & ADtEAderx(1,1,1,1,1,1))
9021 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9022 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
9023 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9024 & ADtEA1derx(1,1,1,1,1,1))
9026 C End 6-th order cumulants
9029 cd write (2,*) 'In calc_eello6'
9031 cd write (2,*) 'iii=',iii
9033 cd write (2,*) 'kkk=',kkk
9035 cd write (2,'(3(2f10.5),5x)')
9036 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9041 call transpose2(EUgder(1,1,k),auxmat(1,1))
9042 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9043 call transpose2(EUg(1,1,k),auxmat(1,1))
9044 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9045 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9049 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9050 & EAEAderx(1,1,lll,kkk,iii,1))
9054 C A1T kernel(i+1) A2
9055 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9056 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
9057 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9058 C Following matrices are needed only for 6-th order cumulants
9059 IF (wcorr6.gt.0.0d0) THEN
9060 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9061 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
9062 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9063 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9064 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
9065 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9066 & ADtEAderx(1,1,1,1,1,2))
9067 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9068 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
9069 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9070 & ADtEA1derx(1,1,1,1,1,2))
9072 C End 6-th order cumulants
9073 call transpose2(EUgder(1,1,l),auxmat(1,1))
9074 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
9075 call transpose2(EUg(1,1,l),auxmat(1,1))
9076 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9077 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9081 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9082 & EAEAderx(1,1,lll,kkk,iii,2))
9087 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9088 C They are needed only when the fifth- or the sixth-order cumulants are
9090 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
9091 call transpose2(AEA(1,1,1),auxmat(1,1))
9092 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9093 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9094 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9095 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9096 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9097 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9098 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9099 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9100 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9101 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9102 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9103 call transpose2(AEA(1,1,2),auxmat(1,1))
9104 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
9105 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
9106 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
9107 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9108 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
9109 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
9110 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
9111 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
9112 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
9113 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
9114 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
9115 C Calculate the Cartesian derivatives of the vectors.
9119 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9120 call matvec2(auxmat(1,1),b1(1,i),
9121 & AEAb1derx(1,lll,kkk,iii,1,1))
9122 call matvec2(auxmat(1,1),Ub2(1,i),
9123 & AEAb2derx(1,lll,kkk,iii,1,1))
9124 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9125 & AEAb1derx(1,lll,kkk,iii,2,1))
9126 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9127 & AEAb2derx(1,lll,kkk,iii,2,1))
9128 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9129 call matvec2(auxmat(1,1),b1(1,j),
9130 & AEAb1derx(1,lll,kkk,iii,1,2))
9131 call matvec2(auxmat(1,1),Ub2(1,j),
9132 & AEAb2derx(1,lll,kkk,iii,1,2))
9133 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9134 & AEAb1derx(1,lll,kkk,iii,2,2))
9135 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
9136 & AEAb2derx(1,lll,kkk,iii,2,2))
9143 C Antiparallel orientation of the two CA-CA-CA frames.
9145 iti=itype2loc(itype(i))
9149 itk1=itype2loc(itype(k+1))
9150 itl=itype2loc(itype(l))
9151 itj=itype2loc(itype(j))
9152 if (j.lt.nres-1) then
9153 itj1=itype2loc(itype(j+1))
9157 C A2 kernel(j-1)T A1T
9158 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9159 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
9160 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9161 C Following matrices are needed only for 6-th order cumulants
9162 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9163 & j.eq.i+4 .and. l.eq.i+3)) THEN
9164 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9165 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
9166 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9167 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9168 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
9169 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9170 & ADtEAderx(1,1,1,1,1,1))
9171 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9172 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
9173 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9174 & ADtEA1derx(1,1,1,1,1,1))
9176 C End 6-th order cumulants
9177 call transpose2(EUgder(1,1,k),auxmat(1,1))
9178 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9179 call transpose2(EUg(1,1,k),auxmat(1,1))
9180 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9181 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9185 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9186 & EAEAderx(1,1,lll,kkk,iii,1))
9190 C A2T kernel(i+1)T A1
9191 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9192 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
9193 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9194 C Following matrices are needed only for 6-th order cumulants
9195 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9196 & j.eq.i+4 .and. l.eq.i+3)) THEN
9197 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9198 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
9199 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9200 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9201 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
9202 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9203 & ADtEAderx(1,1,1,1,1,2))
9204 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9205 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
9206 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9207 & ADtEA1derx(1,1,1,1,1,2))
9209 C End 6-th order cumulants
9210 call transpose2(EUgder(1,1,j),auxmat(1,1))
9211 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9212 call transpose2(EUg(1,1,j),auxmat(1,1))
9213 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9214 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9218 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9219 & EAEAderx(1,1,lll,kkk,iii,2))
9224 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9225 C They are needed only when the fifth- or the sixth-order cumulants are
9227 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
9228 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9229 call transpose2(AEA(1,1,1),auxmat(1,1))
9230 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9231 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9232 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9233 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9234 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9235 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9236 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9237 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9238 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9239 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9240 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9241 call transpose2(AEA(1,1,2),auxmat(1,1))
9242 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
9243 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9244 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9245 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9246 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
9247 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9248 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
9249 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
9250 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9251 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9252 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9253 C Calculate the Cartesian derivatives of the vectors.
9257 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9258 call matvec2(auxmat(1,1),b1(1,i),
9259 & AEAb1derx(1,lll,kkk,iii,1,1))
9260 call matvec2(auxmat(1,1),Ub2(1,i),
9261 & AEAb2derx(1,lll,kkk,iii,1,1))
9262 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9263 & AEAb1derx(1,lll,kkk,iii,2,1))
9264 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9265 & AEAb2derx(1,lll,kkk,iii,2,1))
9266 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9267 call matvec2(auxmat(1,1),b1(1,l),
9268 & AEAb1derx(1,lll,kkk,iii,1,2))
9269 call matvec2(auxmat(1,1),Ub2(1,l),
9270 & AEAb2derx(1,lll,kkk,iii,1,2))
9271 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
9272 & AEAb1derx(1,lll,kkk,iii,2,2))
9273 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
9274 & AEAb2derx(1,lll,kkk,iii,2,2))
9283 C---------------------------------------------------------------------------
9284 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
9285 & KK,KKderg,AKA,AKAderg,AKAderx)
9289 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
9290 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
9291 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
9296 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9298 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
9301 cd if (lprn) write (2,*) 'In kernel'
9303 cd if (lprn) write (2,*) 'kkk=',kkk
9305 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
9306 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9308 cd write (2,*) 'lll=',lll
9309 cd write (2,*) 'iii=1'
9311 cd write (2,'(3(2f10.5),5x)')
9312 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9315 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
9316 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9318 cd write (2,*) 'lll=',lll
9319 cd write (2,*) 'iii=2'
9321 cd write (2,'(3(2f10.5),5x)')
9322 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9329 C---------------------------------------------------------------------------
9330 double precision function eello4(i,j,k,l,jj,kk)
9331 implicit real*8 (a-h,o-z)
9332 include 'DIMENSIONS'
9333 include 'COMMON.IOUNITS'
9334 include 'COMMON.CHAIN'
9335 include 'COMMON.DERIV'
9336 include 'COMMON.INTERACT'
9337 include 'COMMON.CONTACTS'
9338 include 'COMMON.TORSION'
9339 include 'COMMON.VAR'
9340 include 'COMMON.GEO'
9341 double precision pizda(2,2),ggg1(3),ggg2(3)
9342 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9346 cd print *,'eello4:',i,j,k,l,jj,kk
9347 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9348 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9349 cold eij=facont_hb(jj,i)
9350 cold ekl=facont_hb(kk,k)
9352 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9353 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9354 gcorr_loc(k-1)=gcorr_loc(k-1)
9355 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9357 gcorr_loc(l-1)=gcorr_loc(l-1)
9358 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9360 gcorr_loc(j-1)=gcorr_loc(j-1)
9361 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9366 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9367 & -EAEAderx(2,2,lll,kkk,iii,1)
9368 cd derx(lll,kkk,iii)=0.0d0
9372 cd gcorr_loc(l-1)=0.0d0
9373 cd gcorr_loc(j-1)=0.0d0
9374 cd gcorr_loc(k-1)=0.0d0
9376 cd write (iout,*)'Contacts have occurred for peptide groups',
9377 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9378 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9379 if (j.lt.nres-1) then
9386 if (l.lt.nres-1) then
9394 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9395 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9396 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9397 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9398 cgrad ghalf=0.5d0*ggg1(ll)
9399 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9400 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9401 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9402 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9403 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9404 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9405 cgrad ghalf=0.5d0*ggg2(ll)
9406 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9407 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9408 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9409 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9410 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9411 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9415 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9420 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9425 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9430 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9434 cd write (2,*) iii,gcorr_loc(iii)
9437 cd write (2,*) 'ekont',ekont
9438 cd write (iout,*) 'eello4',ekont*eel4
9441 C---------------------------------------------------------------------------
9442 double precision function eello5(i,j,k,l,jj,kk)
9443 implicit real*8 (a-h,o-z)
9444 include 'DIMENSIONS'
9445 include 'COMMON.IOUNITS'
9446 include 'COMMON.CHAIN'
9447 include 'COMMON.DERIV'
9448 include 'COMMON.INTERACT'
9449 include 'COMMON.CONTACTS'
9450 include 'COMMON.TORSION'
9451 include 'COMMON.VAR'
9452 include 'COMMON.GEO'
9453 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9454 double precision ggg1(3),ggg2(3)
9455 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9460 C /l\ / \ \ / \ / \ / C
9461 C / \ / \ \ / \ / \ / C
9462 C j| o |l1 | o | o| o | | o |o C
9463 C \ |/k\| |/ \| / |/ \| |/ \| C
9464 C \i/ \ / \ / / \ / \ C
9466 C (I) (II) (III) (IV) C
9468 C eello5_1 eello5_2 eello5_3 eello5_4 C
9470 C Antiparallel chains C
9473 C /j\ / \ \ / \ / \ / C
9474 C / \ / \ \ / \ / \ / C
9475 C j1| o |l | o | o| o | | o |o C
9476 C \ |/k\| |/ \| / |/ \| |/ \| C
9477 C \i/ \ / \ / / \ / \ C
9479 C (I) (II) (III) (IV) C
9481 C eello5_1 eello5_2 eello5_3 eello5_4 C
9483 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9485 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9486 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9491 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9493 itk=itype2loc(itype(k))
9494 itl=itype2loc(itype(l))
9495 itj=itype2loc(itype(j))
9500 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9501 cd & eel5_3_num,eel5_4_num)
9505 derx(lll,kkk,iii)=0.0d0
9509 cd eij=facont_hb(jj,i)
9510 cd ekl=facont_hb(kk,k)
9512 cd write (iout,*)'Contacts have occurred for peptide groups',
9513 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9515 C Contribution from the graph I.
9516 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9517 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9518 call transpose2(EUg(1,1,k),auxmat(1,1))
9519 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9520 vv(1)=pizda(1,1)-pizda(2,2)
9521 vv(2)=pizda(1,2)+pizda(2,1)
9522 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9523 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9524 C Explicit gradient in virtual-dihedral angles.
9525 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9526 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9527 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9528 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9529 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9530 vv(1)=pizda(1,1)-pizda(2,2)
9531 vv(2)=pizda(1,2)+pizda(2,1)
9532 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9533 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9534 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9535 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9536 vv(1)=pizda(1,1)-pizda(2,2)
9537 vv(2)=pizda(1,2)+pizda(2,1)
9539 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9540 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9541 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9543 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9544 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9545 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9547 C Cartesian gradient
9551 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
9553 vv(1)=pizda(1,1)-pizda(2,2)
9554 vv(2)=pizda(1,2)+pizda(2,1)
9555 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9556 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
9557 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9563 C Contribution from graph II
9564 call transpose2(EE(1,1,k),auxmat(1,1))
9565 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9566 vv(1)=pizda(1,1)+pizda(2,2)
9567 vv(2)=pizda(2,1)-pizda(1,2)
9568 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
9569 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9570 C Explicit gradient in virtual-dihedral angles.
9571 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9572 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9573 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9574 vv(1)=pizda(1,1)+pizda(2,2)
9575 vv(2)=pizda(2,1)-pizda(1,2)
9577 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9578 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9579 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9581 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9582 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9583 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9585 C Cartesian gradient
9589 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9591 vv(1)=pizda(1,1)+pizda(2,2)
9592 vv(2)=pizda(2,1)-pizda(1,2)
9593 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9594 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
9595 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9603 C Parallel orientation
9604 C Contribution from graph III
9605 call transpose2(EUg(1,1,l),auxmat(1,1))
9606 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9607 vv(1)=pizda(1,1)-pizda(2,2)
9608 vv(2)=pizda(1,2)+pizda(2,1)
9609 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
9610 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9611 C Explicit gradient in virtual-dihedral angles.
9612 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9613 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
9614 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9615 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9616 vv(1)=pizda(1,1)-pizda(2,2)
9617 vv(2)=pizda(1,2)+pizda(2,1)
9618 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9619 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
9620 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9621 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9622 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9623 vv(1)=pizda(1,1)-pizda(2,2)
9624 vv(2)=pizda(1,2)+pizda(2,1)
9625 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9626 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
9627 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9628 C Cartesian gradient
9632 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9634 vv(1)=pizda(1,1)-pizda(2,2)
9635 vv(2)=pizda(1,2)+pizda(2,1)
9636 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9637 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
9638 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9643 C Contribution from graph IV
9645 call transpose2(EE(1,1,l),auxmat(1,1))
9646 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9647 vv(1)=pizda(1,1)+pizda(2,2)
9648 vv(2)=pizda(2,1)-pizda(1,2)
9649 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
9650 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9651 C Explicit gradient in virtual-dihedral angles.
9652 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9653 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9654 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9655 vv(1)=pizda(1,1)+pizda(2,2)
9656 vv(2)=pizda(2,1)-pizda(1,2)
9657 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9658 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
9659 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9660 C Cartesian gradient
9664 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9666 vv(1)=pizda(1,1)+pizda(2,2)
9667 vv(2)=pizda(2,1)-pizda(1,2)
9668 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9669 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
9670 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9675 C Antiparallel orientation
9676 C Contribution from graph III
9678 call transpose2(EUg(1,1,j),auxmat(1,1))
9679 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9680 vv(1)=pizda(1,1)-pizda(2,2)
9681 vv(2)=pizda(1,2)+pizda(2,1)
9682 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9683 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9684 C Explicit gradient in virtual-dihedral angles.
9685 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9686 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9687 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9688 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9689 vv(1)=pizda(1,1)-pizda(2,2)
9690 vv(2)=pizda(1,2)+pizda(2,1)
9691 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9692 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9693 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9694 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9695 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9696 vv(1)=pizda(1,1)-pizda(2,2)
9697 vv(2)=pizda(1,2)+pizda(2,1)
9698 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9699 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9700 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9701 C Cartesian gradient
9705 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9707 vv(1)=pizda(1,1)-pizda(2,2)
9708 vv(2)=pizda(1,2)+pizda(2,1)
9709 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9710 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9711 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9716 C Contribution from graph IV
9718 call transpose2(EE(1,1,j),auxmat(1,1))
9719 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9720 vv(1)=pizda(1,1)+pizda(2,2)
9721 vv(2)=pizda(2,1)-pizda(1,2)
9722 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9723 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9724 C Explicit gradient in virtual-dihedral angles.
9725 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9726 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9727 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9728 vv(1)=pizda(1,1)+pizda(2,2)
9729 vv(2)=pizda(2,1)-pizda(1,2)
9730 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9731 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9732 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9733 C Cartesian gradient
9737 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9739 vv(1)=pizda(1,1)+pizda(2,2)
9740 vv(2)=pizda(2,1)-pizda(1,2)
9741 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9742 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9743 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9749 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9750 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9751 cd write (2,*) 'ijkl',i,j,k,l
9752 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9753 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9755 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9756 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9757 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9758 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9759 if (j.lt.nres-1) then
9766 if (l.lt.nres-1) then
9776 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9777 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9778 C summed up outside the subrouine as for the other subroutines
9779 C handling long-range interactions. The old code is commented out
9780 C with "cgrad" to keep track of changes.
9782 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9783 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9784 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9785 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9786 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9787 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9788 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9789 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9790 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9791 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9793 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9794 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9795 cgrad ghalf=0.5d0*ggg1(ll)
9797 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9798 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9799 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9800 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9801 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9802 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9803 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9804 cgrad ghalf=0.5d0*ggg2(ll)
9806 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
9807 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9808 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
9809 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9810 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9811 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9816 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9817 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9822 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9823 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9829 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9834 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9838 cd write (2,*) iii,g_corr5_loc(iii)
9841 cd write (2,*) 'ekont',ekont
9842 cd write (iout,*) 'eello5',ekont*eel5
9845 c--------------------------------------------------------------------------
9846 double precision function eello6(i,j,k,l,jj,kk)
9847 implicit real*8 (a-h,o-z)
9848 include 'DIMENSIONS'
9849 include 'COMMON.IOUNITS'
9850 include 'COMMON.CHAIN'
9851 include 'COMMON.DERIV'
9852 include 'COMMON.INTERACT'
9853 include 'COMMON.CONTACTS'
9854 include 'COMMON.TORSION'
9855 include 'COMMON.VAR'
9856 include 'COMMON.GEO'
9857 include 'COMMON.FFIELD'
9858 double precision ggg1(3),ggg2(3)
9859 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9864 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9872 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9873 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9877 derx(lll,kkk,iii)=0.0d0
9881 cd eij=facont_hb(jj,i)
9882 cd ekl=facont_hb(kk,k)
9888 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9889 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9890 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9891 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9892 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9893 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9895 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9896 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9897 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9898 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9899 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9900 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9904 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9906 C If turn contributions are considered, they will be handled separately.
9907 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9908 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9909 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9910 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9911 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9912 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9913 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9915 if (j.lt.nres-1) then
9922 if (l.lt.nres-1) then
9930 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9931 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9932 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9933 cgrad ghalf=0.5d0*ggg1(ll)
9935 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9936 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9937 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9938 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9939 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9940 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9941 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9942 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9943 cgrad ghalf=0.5d0*ggg2(ll)
9944 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9946 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9947 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9948 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9949 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9950 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9951 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9956 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9957 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9962 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9963 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9969 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9974 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9978 cd write (2,*) iii,g_corr6_loc(iii)
9981 cd write (2,*) 'ekont',ekont
9982 cd write (iout,*) 'eello6',ekont*eel6
9985 c--------------------------------------------------------------------------
9986 double precision function eello6_graph1(i,j,k,l,imat,swap)
9987 implicit real*8 (a-h,o-z)
9988 include 'DIMENSIONS'
9989 include 'COMMON.IOUNITS'
9990 include 'COMMON.CHAIN'
9991 include 'COMMON.DERIV'
9992 include 'COMMON.INTERACT'
9993 include 'COMMON.CONTACTS'
9994 include 'COMMON.TORSION'
9995 include 'COMMON.VAR'
9996 include 'COMMON.GEO'
9997 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
10000 common /kutas/ lprn
10001 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10003 C Parallel Antiparallel C
10009 C \ j|/k\| / \ |/k\|l / C
10010 C \ / \ / \ / \ / C
10014 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10015 itk=itype2loc(itype(k))
10016 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
10017 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
10018 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
10019 call transpose2(EUgC(1,1,k),auxmat(1,1))
10020 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10021 vv1(1)=pizda1(1,1)-pizda1(2,2)
10022 vv1(2)=pizda1(1,2)+pizda1(2,1)
10023 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10024 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
10025 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
10026 s5=scalar2(vv(1),Dtobr2(1,i))
10027 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
10028 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
10029 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
10030 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
10031 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
10032 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
10033 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
10034 & +scalar2(vv(1),Dtobr2der(1,i)))
10035 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
10036 vv1(1)=pizda1(1,1)-pizda1(2,2)
10037 vv1(2)=pizda1(1,2)+pizda1(2,1)
10038 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
10039 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
10041 g_corr6_loc(l-1)=g_corr6_loc(l-1)
10042 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
10043 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
10044 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
10045 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10047 g_corr6_loc(j-1)=g_corr6_loc(j-1)
10048 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
10049 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
10050 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
10051 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10053 call transpose2(EUgCder(1,1,k),auxmat(1,1))
10054 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10055 vv1(1)=pizda1(1,1)-pizda1(2,2)
10056 vv1(2)=pizda1(1,2)+pizda1(2,1)
10057 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
10058 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
10059 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
10060 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
10069 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
10070 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
10071 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
10072 call transpose2(EUgC(1,1,k),auxmat(1,1))
10073 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10075 vv1(1)=pizda1(1,1)-pizda1(2,2)
10076 vv1(2)=pizda1(1,2)+pizda1(2,1)
10077 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10078 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
10079 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
10080 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
10081 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
10082 s5=scalar2(vv(1),Dtobr2(1,i))
10083 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
10089 c----------------------------------------------------------------------------
10090 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
10091 implicit real*8 (a-h,o-z)
10092 include 'DIMENSIONS'
10093 include 'COMMON.IOUNITS'
10094 include 'COMMON.CHAIN'
10095 include 'COMMON.DERIV'
10096 include 'COMMON.INTERACT'
10097 include 'COMMON.CONTACTS'
10098 include 'COMMON.TORSION'
10099 include 'COMMON.VAR'
10100 include 'COMMON.GEO'
10102 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10103 & auxvec1(2),auxvec2(2),auxmat1(2,2)
10105 common /kutas/ lprn
10106 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10108 C Parallel Antiparallel C
10114 C \ j|/k\| \ |/k\|l C
10119 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10120 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
10121 C AL 7/4/01 s1 would occur in the sixth-order moment,
10122 C but not in a cluster cumulant
10124 s1=dip(1,jj,i)*dip(1,kk,k)
10126 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
10127 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10128 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
10129 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
10130 call transpose2(EUg(1,1,k),auxmat(1,1))
10131 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
10132 vv(1)=pizda(1,1)-pizda(2,2)
10133 vv(2)=pizda(1,2)+pizda(2,1)
10134 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10135 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10137 eello6_graph2=-(s1+s2+s3+s4)
10139 eello6_graph2=-(s2+s3+s4)
10141 c eello6_graph2=-s3
10142 C Derivatives in gamma(i-1)
10145 s1=dipderg(1,jj,i)*dip(1,kk,k)
10147 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10148 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
10149 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10150 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10152 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10154 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10156 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
10158 C Derivatives in gamma(k-1)
10160 s1=dip(1,jj,i)*dipderg(1,kk,k)
10162 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
10163 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10164 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
10165 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10166 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10167 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
10168 vv(1)=pizda(1,1)-pizda(2,2)
10169 vv(2)=pizda(1,2)+pizda(2,1)
10170 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10172 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10174 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10176 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
10177 C Derivatives in gamma(j-1) or gamma(l-1)
10180 s1=dipderg(3,jj,i)*dip(1,kk,k)
10182 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
10183 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10184 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
10185 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
10186 vv(1)=pizda(1,1)-pizda(2,2)
10187 vv(2)=pizda(1,2)+pizda(2,1)
10188 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10191 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10193 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10196 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10197 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10199 C Derivatives in gamma(l-1) or gamma(j-1)
10202 s1=dip(1,jj,i)*dipderg(3,kk,k)
10204 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10205 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10206 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10207 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10208 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10209 vv(1)=pizda(1,1)-pizda(2,2)
10210 vv(2)=pizda(1,2)+pizda(2,1)
10211 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10214 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10216 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10219 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10220 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10222 C Cartesian derivatives.
10224 write (2,*) 'In eello6_graph2'
10226 write (2,*) 'iii=',iii
10228 write (2,*) 'kkk=',kkk
10230 write (2,'(3(2f10.5),5x)')
10231 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10241 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10243 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10246 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
10248 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10249 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
10251 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10252 call transpose2(EUg(1,1,k),auxmat(1,1))
10253 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
10255 vv(1)=pizda(1,1)-pizda(2,2)
10256 vv(2)=pizda(1,2)+pizda(2,1)
10257 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10258 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10260 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10262 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10265 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10267 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10274 c----------------------------------------------------------------------------
10275 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
10276 implicit real*8 (a-h,o-z)
10277 include 'DIMENSIONS'
10278 include 'COMMON.IOUNITS'
10279 include 'COMMON.CHAIN'
10280 include 'COMMON.DERIV'
10281 include 'COMMON.INTERACT'
10282 include 'COMMON.CONTACTS'
10283 include 'COMMON.TORSION'
10284 include 'COMMON.VAR'
10285 include 'COMMON.GEO'
10286 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
10288 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10290 C Parallel Antiparallel C
10295 C /| o |o o| o |\ C
10296 C j|/k\| / |/k\|l / C
10301 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10303 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10304 C energy moment and not to the cluster cumulant.
10305 iti=itortyp(itype(i))
10306 if (j.lt.nres-1) then
10307 itj1=itype2loc(itype(j+1))
10311 itk=itype2loc(itype(k))
10312 itk1=itype2loc(itype(k+1))
10313 if (l.lt.nres-1) then
10314 itl1=itype2loc(itype(l+1))
10319 s1=dip(4,jj,i)*dip(4,kk,k)
10321 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
10322 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10323 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
10324 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10325 call transpose2(EE(1,1,k),auxmat(1,1))
10326 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10327 vv(1)=pizda(1,1)+pizda(2,2)
10328 vv(2)=pizda(2,1)-pizda(1,2)
10329 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10330 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10331 cd & "sum",-(s2+s3+s4)
10333 eello6_graph3=-(s1+s2+s3+s4)
10335 eello6_graph3=-(s2+s3+s4)
10337 c eello6_graph3=-s4
10338 C Derivatives in gamma(k-1)
10339 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
10340 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10341 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10342 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10343 C Derivatives in gamma(l-1)
10344 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
10345 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10346 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10347 vv(1)=pizda(1,1)+pizda(2,2)
10348 vv(2)=pizda(2,1)-pizda(1,2)
10349 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10350 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10351 C Cartesian derivatives.
10357 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10359 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10362 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
10364 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10365 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
10367 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10368 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
10370 vv(1)=pizda(1,1)+pizda(2,2)
10371 vv(2)=pizda(2,1)-pizda(1,2)
10372 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10374 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10376 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10379 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10381 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10383 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10389 c----------------------------------------------------------------------------
10390 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10391 implicit real*8 (a-h,o-z)
10392 include 'DIMENSIONS'
10393 include 'COMMON.IOUNITS'
10394 include 'COMMON.CHAIN'
10395 include 'COMMON.DERIV'
10396 include 'COMMON.INTERACT'
10397 include 'COMMON.CONTACTS'
10398 include 'COMMON.TORSION'
10399 include 'COMMON.VAR'
10400 include 'COMMON.GEO'
10401 include 'COMMON.FFIELD'
10402 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10403 & auxvec1(2),auxmat1(2,2)
10405 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10407 C Parallel Antiparallel C
10412 C /| o |o o| o |\ C
10413 C \ j|/k\| \ |/k\|l C
10418 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10420 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10421 C energy moment and not to the cluster cumulant.
10422 cd write (2,*) 'eello_graph4: wturn6',wturn6
10423 iti=itype2loc(itype(i))
10424 itj=itype2loc(itype(j))
10425 if (j.lt.nres-1) then
10426 itj1=itype2loc(itype(j+1))
10430 itk=itype2loc(itype(k))
10431 if (k.lt.nres-1) then
10432 itk1=itype2loc(itype(k+1))
10436 itl=itype2loc(itype(l))
10437 if (l.lt.nres-1) then
10438 itl1=itype2loc(itype(l+1))
10442 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10443 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10444 cd & ' itl',itl,' itl1',itl1
10446 if (imat.eq.1) then
10447 s1=dip(3,jj,i)*dip(3,kk,k)
10449 s1=dip(2,jj,j)*dip(2,kk,l)
10452 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10453 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10455 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
10456 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10458 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
10459 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10461 call transpose2(EUg(1,1,k),auxmat(1,1))
10462 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10463 vv(1)=pizda(1,1)-pizda(2,2)
10464 vv(2)=pizda(2,1)+pizda(1,2)
10465 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10466 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10468 eello6_graph4=-(s1+s2+s3+s4)
10470 eello6_graph4=-(s2+s3+s4)
10472 C Derivatives in gamma(i-1)
10475 if (imat.eq.1) then
10476 s1=dipderg(2,jj,i)*dip(3,kk,k)
10478 s1=dipderg(4,jj,j)*dip(2,kk,l)
10481 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10483 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
10484 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10486 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
10487 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10489 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10490 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10491 cd write (2,*) 'turn6 derivatives'
10493 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10495 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10499 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10501 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10505 C Derivatives in gamma(k-1)
10507 if (imat.eq.1) then
10508 s1=dip(3,jj,i)*dipderg(2,kk,k)
10510 s1=dip(2,jj,j)*dipderg(4,kk,l)
10513 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10514 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10516 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
10517 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10519 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
10520 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10522 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10523 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10524 vv(1)=pizda(1,1)-pizda(2,2)
10525 vv(2)=pizda(2,1)+pizda(1,2)
10526 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10527 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10529 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10531 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10535 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10537 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10540 C Derivatives in gamma(j-1) or gamma(l-1)
10541 if (l.eq.j+1 .and. l.gt.1) then
10542 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10543 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10544 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10545 vv(1)=pizda(1,1)-pizda(2,2)
10546 vv(2)=pizda(2,1)+pizda(1,2)
10547 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10548 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10549 else if (j.gt.1) then
10550 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10551 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10552 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10553 vv(1)=pizda(1,1)-pizda(2,2)
10554 vv(2)=pizda(2,1)+pizda(1,2)
10555 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10556 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10557 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10559 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10562 C Cartesian derivatives.
10568 if (imat.eq.1) then
10569 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10571 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10574 if (imat.eq.1) then
10575 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10577 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10581 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
10583 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10585 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10586 & b1(1,j+1),auxvec(1))
10587 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
10589 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10590 & b1(1,l+1),auxvec(1))
10591 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
10593 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10595 vv(1)=pizda(1,1)-pizda(2,2)
10596 vv(2)=pizda(2,1)+pizda(1,2)
10597 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10599 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10601 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10604 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10607 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10610 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10612 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10614 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10618 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10620 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10623 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10625 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10633 c----------------------------------------------------------------------------
10634 double precision function eello_turn6(i,jj,kk)
10635 implicit real*8 (a-h,o-z)
10636 include 'DIMENSIONS'
10637 include 'COMMON.IOUNITS'
10638 include 'COMMON.CHAIN'
10639 include 'COMMON.DERIV'
10640 include 'COMMON.INTERACT'
10641 include 'COMMON.CONTACTS'
10642 include 'COMMON.TORSION'
10643 include 'COMMON.VAR'
10644 include 'COMMON.GEO'
10645 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
10646 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
10648 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
10649 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
10650 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10651 C the respective energy moment and not to the cluster cumulant.
10660 iti=itype2loc(itype(i))
10661 itk=itype2loc(itype(k))
10662 itk1=itype2loc(itype(k+1))
10663 itl=itype2loc(itype(l))
10664 itj=itype2loc(itype(j))
10665 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10666 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
10667 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10672 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10674 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10678 derx_turn(lll,kkk,iii)=0.0d0
10685 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10687 cd write (2,*) 'eello6_5',eello6_5
10689 call transpose2(AEA(1,1,1),auxmat(1,1))
10690 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10691 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10692 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10694 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10695 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10696 s2 = scalar2(b1(1,k),vtemp1(1))
10698 call transpose2(AEA(1,1,2),atemp(1,1))
10699 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10700 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10701 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10703 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10704 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10705 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10707 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10708 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10709 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10710 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10711 ss13 = scalar2(b1(1,k),vtemp4(1))
10712 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10714 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10720 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10721 C Derivatives in gamma(i+2)
10725 call transpose2(AEA(1,1,1),auxmatd(1,1))
10726 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10727 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10728 call transpose2(AEAderg(1,1,2),atempd(1,1))
10729 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10730 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10732 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10733 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10734 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10740 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10741 C Derivatives in gamma(i+3)
10743 call transpose2(AEA(1,1,1),auxmatd(1,1))
10744 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10745 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10746 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10748 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10749 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10750 s2d = scalar2(b1(1,k),vtemp1d(1))
10752 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10753 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10755 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10757 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10758 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10759 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10767 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10768 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10770 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10771 & -0.5d0*ekont*(s2d+s12d)
10773 C Derivatives in gamma(i+4)
10774 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10775 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10776 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10778 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10779 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10780 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10788 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10790 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10792 C Derivatives in gamma(i+5)
10794 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10795 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10796 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10798 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10799 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10800 s2d = scalar2(b1(1,k),vtemp1d(1))
10802 call transpose2(AEA(1,1,2),atempd(1,1))
10803 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10804 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10806 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10807 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10809 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10810 ss13d = scalar2(b1(1,k),vtemp4d(1))
10811 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10819 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10820 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10822 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10823 & -0.5d0*ekont*(s2d+s12d)
10825 C Cartesian derivatives
10830 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10831 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10832 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10834 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10835 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10837 s2d = scalar2(b1(1,k),vtemp1d(1))
10839 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10840 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10841 s8d = -(atempd(1,1)+atempd(2,2))*
10842 & scalar2(cc(1,1,itl),vtemp2(1))
10844 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10846 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10847 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10854 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10855 & - 0.5d0*(s1d+s2d)
10857 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10861 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10862 & - 0.5d0*(s8d+s12d)
10864 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10873 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10874 & achuj_tempd(1,1))
10875 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10876 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10877 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10878 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10879 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10881 ss13d = scalar2(b1(1,k),vtemp4d(1))
10882 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10883 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10887 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10888 cd & 16*eel_turn6_num
10890 if (j.lt.nres-1) then
10897 if (l.lt.nres-1) then
10905 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10906 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10907 cgrad ghalf=0.5d0*ggg1(ll)
10909 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10910 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10911 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10912 & +ekont*derx_turn(ll,2,1)
10913 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10914 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10915 & +ekont*derx_turn(ll,4,1)
10916 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10917 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10918 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10919 cgrad ghalf=0.5d0*ggg2(ll)
10921 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10922 & +ekont*derx_turn(ll,2,2)
10923 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10924 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10925 & +ekont*derx_turn(ll,4,2)
10926 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10927 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10928 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10933 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10938 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10944 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10949 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10953 cd write (2,*) iii,g_corr6_loc(iii)
10955 eello_turn6=ekont*eel_turn6
10956 cd write (2,*) 'ekont',ekont
10957 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10961 C-----------------------------------------------------------------------------
10962 double precision function scalar(u,v)
10963 !DIR$ INLINEALWAYS scalar
10965 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10968 double precision u(3),v(3)
10969 cd double precision sc
10977 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10980 crc-------------------------------------------------
10981 SUBROUTINE MATVEC2(A1,V1,V2)
10982 !DIR$ INLINEALWAYS MATVEC2
10984 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10986 implicit real*8 (a-h,o-z)
10987 include 'DIMENSIONS'
10988 DIMENSION A1(2,2),V1(2),V2(2)
10992 c 3 VI=VI+A1(I,K)*V1(K)
10996 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10997 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
11002 C---------------------------------------
11003 SUBROUTINE MATMAT2(A1,A2,A3)
11005 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
11007 implicit real*8 (a-h,o-z)
11008 include 'DIMENSIONS'
11009 DIMENSION A1(2,2),A2(2,2),A3(2,2)
11010 c DIMENSION AI3(2,2)
11014 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
11020 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
11021 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
11022 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
11023 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
11031 c-------------------------------------------------------------------------
11032 double precision function scalar2(u,v)
11033 !DIR$ INLINEALWAYS scalar2
11035 double precision u(2),v(2)
11036 double precision sc
11038 scalar2=u(1)*v(1)+u(2)*v(2)
11042 C-----------------------------------------------------------------------------
11044 subroutine transpose2(a,at)
11045 !DIR$ INLINEALWAYS transpose2
11047 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
11050 double precision a(2,2),at(2,2)
11057 c--------------------------------------------------------------------------
11058 subroutine transpose(n,a,at)
11061 double precision a(n,n),at(n,n)
11069 C---------------------------------------------------------------------------
11070 subroutine prodmat3(a1,a2,kk,transp,prod)
11071 !DIR$ INLINEALWAYS prodmat3
11073 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
11077 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
11079 crc double precision auxmat(2,2),prod_(2,2)
11082 crc call transpose2(kk(1,1),auxmat(1,1))
11083 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
11084 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11086 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
11087 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
11088 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
11089 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
11090 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
11091 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
11092 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
11093 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
11096 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
11097 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11099 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
11100 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
11101 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
11102 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
11103 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
11104 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
11105 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
11106 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
11109 c call transpose2(a2(1,1),a2t(1,1))
11112 crc print *,((prod_(i,j),i=1,2),j=1,2)
11113 crc print *,((prod(i,j),i=1,2),j=1,2)
11117 CCC----------------------------------------------
11118 subroutine Eliptransfer(eliptran)
11119 implicit real*8 (a-h,o-z)
11120 include 'DIMENSIONS'
11121 include 'COMMON.GEO'
11122 include 'COMMON.VAR'
11123 include 'COMMON.LOCAL'
11124 include 'COMMON.CHAIN'
11125 include 'COMMON.DERIV'
11126 include 'COMMON.NAMES'
11127 include 'COMMON.INTERACT'
11128 include 'COMMON.IOUNITS'
11129 include 'COMMON.CALC'
11130 include 'COMMON.CONTROL'
11131 include 'COMMON.SPLITELE'
11132 include 'COMMON.SBRIDGE'
11133 C this is done by Adasko
11134 C print *,"wchodze"
11135 C structure of box:
11137 C--bordliptop-- buffore starts
11138 C--bufliptop--- here true lipid starts
11140 C--buflipbot--- lipid ends buffore starts
11141 C--bordlipbot--buffore ends
11143 do i=ilip_start,ilip_end
11145 if (itype(i).eq.ntyp1) cycle
11147 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
11148 if (positi.le.0.0) positi=positi+boxzsize
11150 C first for peptide groups
11151 c for each residue check if it is in lipid or lipid water border area
11152 if ((positi.gt.bordlipbot)
11153 &.and.(positi.lt.bordliptop)) then
11154 C the energy transfer exist
11155 if (positi.lt.buflipbot) then
11156 C what fraction I am in
11158 & ((positi-bordlipbot)/lipbufthick)
11159 C lipbufthick is thickenes of lipid buffore
11160 sslip=sscalelip(fracinbuf)
11161 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11162 eliptran=eliptran+sslip*pepliptran
11163 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11164 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11165 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11167 C print *,"doing sccale for lower part"
11168 C print *,i,sslip,fracinbuf,ssgradlip
11169 elseif (positi.gt.bufliptop) then
11170 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
11171 sslip=sscalelip(fracinbuf)
11172 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11173 eliptran=eliptran+sslip*pepliptran
11174 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11175 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11176 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11177 C print *, "doing sscalefor top part"
11178 C print *,i,sslip,fracinbuf,ssgradlip
11180 eliptran=eliptran+pepliptran
11181 C print *,"I am in true lipid"
11184 C eliptran=elpitran+0.0 ! I am in water
11187 C print *, "nic nie bylo w lipidzie?"
11188 C now multiply all by the peptide group transfer factor
11189 C eliptran=eliptran*pepliptran
11190 C now the same for side chains
11192 do i=ilip_start,ilip_end
11193 if (itype(i).eq.ntyp1) cycle
11194 positi=(mod(c(3,i+nres),boxzsize))
11195 if (positi.le.0) positi=positi+boxzsize
11196 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
11197 c for each residue check if it is in lipid or lipid water border area
11198 C respos=mod(c(3,i+nres),boxzsize)
11199 C print *,positi,bordlipbot,buflipbot
11200 if ((positi.gt.bordlipbot)
11201 & .and.(positi.lt.bordliptop)) then
11202 C the energy transfer exist
11203 if (positi.lt.buflipbot) then
11205 & ((positi-bordlipbot)/lipbufthick)
11206 C lipbufthick is thickenes of lipid buffore
11207 sslip=sscalelip(fracinbuf)
11208 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11209 eliptran=eliptran+sslip*liptranene(itype(i))
11210 gliptranx(3,i)=gliptranx(3,i)
11211 &+ssgradlip*liptranene(itype(i))
11212 gliptranc(3,i-1)= gliptranc(3,i-1)
11213 &+ssgradlip*liptranene(itype(i))
11214 C print *,"doing sccale for lower part"
11215 elseif (positi.gt.bufliptop) then
11217 &((bordliptop-positi)/lipbufthick)
11218 sslip=sscalelip(fracinbuf)
11219 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11220 eliptran=eliptran+sslip*liptranene(itype(i))
11221 gliptranx(3,i)=gliptranx(3,i)
11222 &+ssgradlip*liptranene(itype(i))
11223 gliptranc(3,i-1)= gliptranc(3,i-1)
11224 &+ssgradlip*liptranene(itype(i))
11225 C print *, "doing sscalefor top part",sslip,fracinbuf
11227 eliptran=eliptran+liptranene(itype(i))
11228 C print *,"I am in true lipid"
11230 endif ! if in lipid or buffor
11232 C eliptran=elpitran+0.0 ! I am in water
11236 C---------------------------------------------------------
11237 C AFM soubroutine for constant force
11238 subroutine AFMforce(Eafmforce)
11239 implicit real*8 (a-h,o-z)
11240 include 'DIMENSIONS'
11241 include 'COMMON.GEO'
11242 include 'COMMON.VAR'
11243 include 'COMMON.LOCAL'
11244 include 'COMMON.CHAIN'
11245 include 'COMMON.DERIV'
11246 include 'COMMON.NAMES'
11247 include 'COMMON.INTERACT'
11248 include 'COMMON.IOUNITS'
11249 include 'COMMON.CALC'
11250 include 'COMMON.CONTROL'
11251 include 'COMMON.SPLITELE'
11252 include 'COMMON.SBRIDGE'
11257 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11258 dist=dist+diffafm(i)**2
11261 Eafmforce=-forceAFMconst*(dist-distafminit)
11263 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
11264 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
11266 C print *,'AFM',Eafmforce
11269 C---------------------------------------------------------
11270 C AFM subroutine with pseudoconstant velocity
11271 subroutine AFMvel(Eafmforce)
11272 implicit real*8 (a-h,o-z)
11273 include 'DIMENSIONS'
11274 include 'COMMON.GEO'
11275 include 'COMMON.VAR'
11276 include 'COMMON.LOCAL'
11277 include 'COMMON.CHAIN'
11278 include 'COMMON.DERIV'
11279 include 'COMMON.NAMES'
11280 include 'COMMON.INTERACT'
11281 include 'COMMON.IOUNITS'
11282 include 'COMMON.CALC'
11283 include 'COMMON.CONTROL'
11284 include 'COMMON.SPLITELE'
11285 include 'COMMON.SBRIDGE'
11287 C Only for check grad COMMENT if not used for checkgrad
11289 C--------------------------------------------------------
11290 C print *,"wchodze"
11294 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11295 dist=dist+diffafm(i)**2
11298 Eafmforce=0.5d0*forceAFMconst
11299 & *(distafminit+totTafm*velAFMconst-dist)**2
11300 C Eafmforce=-forceAFMconst*(dist-distafminit)
11302 gradafm(i,afmend-1)=-forceAFMconst*
11303 &(distafminit+totTafm*velAFMconst-dist)
11305 gradafm(i,afmbeg-1)=forceAFMconst*
11306 &(distafminit+totTafm*velAFMconst-dist)
11309 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
11312 C-----------------------------------------------------------
11313 C first for shielding is setting of function of side-chains
11314 subroutine set_shield_fac
11315 implicit real*8 (a-h,o-z)
11316 include 'DIMENSIONS'
11317 include 'COMMON.CHAIN'
11318 include 'COMMON.DERIV'
11319 include 'COMMON.IOUNITS'
11320 include 'COMMON.SHIELD'
11321 include 'COMMON.INTERACT'
11322 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11323 double precision div77_81/0.974996043d0/,
11324 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11326 C the vector between center of side_chain and peptide group
11327 double precision pep_side(3),long,side_calf(3),
11328 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11329 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11330 C the line belowe needs to be changed for FGPROC>1
11332 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11334 Cif there two consequtive dummy atoms there is no peptide group between them
11335 C the line below has to be changed for FGPROC>1
11338 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11342 C first lets set vector conecting the ithe side-chain with kth side-chain
11343 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11344 C pep_side(j)=2.0d0
11345 C and vector conecting the side-chain with its proper calfa
11346 side_calf(j)=c(j,k+nres)-c(j,k)
11347 C side_calf(j)=2.0d0
11348 pept_group(j)=c(j,i)-c(j,i+1)
11349 C lets have their lenght
11350 dist_pep_side=pep_side(j)**2+dist_pep_side
11351 dist_side_calf=dist_side_calf+side_calf(j)**2
11352 dist_pept_group=dist_pept_group+pept_group(j)**2
11354 dist_pep_side=dsqrt(dist_pep_side)
11355 dist_pept_group=dsqrt(dist_pept_group)
11356 dist_side_calf=dsqrt(dist_side_calf)
11358 pep_side_norm(j)=pep_side(j)/dist_pep_side
11359 side_calf_norm(j)=dist_side_calf
11361 C now sscale fraction
11362 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
11363 C print *,buff_shield,"buff"
11365 if (sh_frac_dist.le.0.0) cycle
11366 C If we reach here it means that this side chain reaches the shielding sphere
11367 C Lets add him to the list for gradient
11368 ishield_list(i)=ishield_list(i)+1
11369 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
11370 C this list is essential otherwise problem would be O3
11371 shield_list(ishield_list(i),i)=k
11372 C Lets have the sscale value
11373 if (sh_frac_dist.gt.1.0) then
11374 scale_fac_dist=1.0d0
11376 sh_frac_dist_grad(j)=0.0d0
11379 scale_fac_dist=-sh_frac_dist*sh_frac_dist
11380 & *(2.0*sh_frac_dist-3.0d0)
11381 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
11382 & /dist_pep_side/buff_shield*0.5
11383 C remember for the final gradient multiply sh_frac_dist_grad(j)
11384 C for side_chain by factor -2 !
11386 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
11387 C print *,"jestem",scale_fac_dist,fac_help_scale,
11388 C & sh_frac_dist_grad(j)
11391 C if ((i.eq.3).and.(k.eq.2)) then
11392 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
11396 C this is what is now we have the distance scaling now volume...
11397 short=short_r_sidechain(itype(k))
11398 long=long_r_sidechain(itype(k))
11399 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
11402 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
11403 C costhet_fac=0.0d0
11405 costhet_grad(j)=costhet_fac*pep_side(j)
11407 C remember for the final gradient multiply costhet_grad(j)
11408 C for side_chain by factor -2 !
11409 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
11410 C pep_side0pept_group is vector multiplication
11411 pep_side0pept_group=0.0
11413 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
11415 cosalfa=(pep_side0pept_group/
11416 & (dist_pep_side*dist_side_calf))
11417 fac_alfa_sin=1.0-cosalfa**2
11418 fac_alfa_sin=dsqrt(fac_alfa_sin)
11419 rkprim=fac_alfa_sin*(long-short)+short
11421 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
11422 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
11425 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
11426 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11427 &*(long-short)/fac_alfa_sin*cosalfa/
11428 &((dist_pep_side*dist_side_calf))*
11429 &((side_calf(j))-cosalfa*
11430 &((pep_side(j)/dist_pep_side)*dist_side_calf))
11432 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11433 &*(long-short)/fac_alfa_sin*cosalfa
11434 &/((dist_pep_side*dist_side_calf))*
11436 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
11439 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
11442 C now the gradient...
11443 C grad_shield is gradient of Calfa for peptide groups
11444 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
11446 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
11447 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
11449 grad_shield(j,i)=grad_shield(j,i)
11450 C gradient po skalowaniu
11451 & +(sh_frac_dist_grad(j)
11452 C gradient po costhet
11453 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
11454 &-scale_fac_dist*(cosphi_grad_long(j))
11455 &/(1.0-cosphi) )*div77_81
11457 C grad_shield_side is Cbeta sidechain gradient
11458 grad_shield_side(j,ishield_list(i),i)=
11459 & (sh_frac_dist_grad(j)*-2.0d0
11460 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
11461 & +scale_fac_dist*(cosphi_grad_long(j))
11462 & *2.0d0/(1.0-cosphi))
11463 & *div77_81*VofOverlap
11465 grad_shield_loc(j,ishield_list(i),i)=
11466 & scale_fac_dist*cosphi_grad_loc(j)
11467 & *2.0d0/(1.0-cosphi)
11468 & *div77_81*VofOverlap
11470 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
11472 fac_shield(i)=VolumeTotal*div77_81+div4_81
11473 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
11477 C--------------------------------------------------------------------------
11478 double precision function tschebyshev(m,n,x,y)
11480 include "DIMENSIONS"
11482 double precision x(n),y,yy(0:maxvar),aux
11483 c Tschebyshev polynomial. Note that the first term is omitted
11484 c m=0: the constant term is included
11485 c m=1: the constant term is not included
11489 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
11498 C--------------------------------------------------------------------------
11499 double precision function gradtschebyshev(m,n,x,y)
11501 include "DIMENSIONS"
11503 double precision x(n+1),y,yy(0:maxvar),aux
11504 c Tschebyshev polynomial. Note that the first term is omitted
11505 c m=0: the constant term is included
11506 c m=1: the constant term is not included
11510 yy(i)=2*y*yy(i-1)-yy(i-2)
11514 aux=aux+x(i+1)*yy(i)*(i+1)
11515 C print *, x(i+1),yy(i),i
11517 gradtschebyshev=aux
11520 C------------------------------------------------------------------------
11521 C first for shielding is setting of function of side-chains
11522 subroutine set_shield_fac2
11523 implicit real*8 (a-h,o-z)
11524 include 'DIMENSIONS'
11525 include 'COMMON.CHAIN'
11526 include 'COMMON.DERIV'
11527 include 'COMMON.IOUNITS'
11528 include 'COMMON.SHIELD'
11529 include 'COMMON.INTERACT'
11530 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11531 double precision div77_81/0.974996043d0/,
11532 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11534 C the vector between center of side_chain and peptide group
11535 double precision pep_side(3),long,side_calf(3),
11536 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11537 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11538 C the line belowe needs to be changed for FGPROC>1
11539 do i=iatscp_s,iatscp_e
11541 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11543 Cif there two consequtive dummy atoms there is no peptide group between them
11544 C the line below has to be changed for FGPROC>1
11547 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11551 C first lets set vector conecting the ithe side-chain with kth side-chain
11552 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11553 C pep_side(j)=2.0d0
11554 C and vector conecting the side-chain with its proper calfa
11555 side_calf(j)=c(j,k+nres)-c(j,k)
11556 C side_calf(j)=2.0d0
11557 pept_group(j)=c(j,i)-c(j,i+1)
11558 C lets have their lenght
11559 dist_pep_side=pep_side(j)**2+dist_pep_side
11560 dist_side_calf=dist_side_calf+side_calf(j)**2
11561 dist_pept_group=dist_pept_group+pept_group(j)**2
11563 dist_pep_side=dsqrt(dist_pep_side)
11564 dist_pept_group=dsqrt(dist_pept_group)
11565 dist_side_calf=dsqrt(dist_side_calf)
11567 pep_side_norm(j)=pep_side(j)/dist_pep_side
11568 side_calf_norm(j)=dist_side_calf
11570 C now sscale fraction
11571 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
11572 C print *,buff_shield,"buff"
11574 if (sh_frac_dist.le.0.0) cycle
11575 C If we reach here it means that this side chain reaches the shielding sphere
11576 C Lets add him to the list for gradient
11577 ishield_list(i)=ishield_list(i)+1
11578 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
11579 C this list is essential otherwise problem would be O3
11580 shield_list(ishield_list(i),i)=k
11581 C Lets have the sscale value
11582 if (sh_frac_dist.gt.1.0) then
11583 scale_fac_dist=1.0d0
11585 sh_frac_dist_grad(j)=0.0d0
11588 scale_fac_dist=-sh_frac_dist*sh_frac_dist
11589 & *(2.0d0*sh_frac_dist-3.0d0)
11590 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
11591 & /dist_pep_side/buff_shield*0.5d0
11592 C remember for the final gradient multiply sh_frac_dist_grad(j)
11593 C for side_chain by factor -2 !
11595 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
11596 C sh_frac_dist_grad(j)=0.0d0
11597 C scale_fac_dist=1.0d0
11598 C print *,"jestem",scale_fac_dist,fac_help_scale,
11599 C & sh_frac_dist_grad(j)
11602 C this is what is now we have the distance scaling now volume...
11603 short=short_r_sidechain(itype(k))
11604 long=long_r_sidechain(itype(k))
11605 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
11606 sinthet=short/dist_pep_side*costhet
11610 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
11611 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
11612 C & -short/dist_pep_side**2/costhet)
11613 C costhet_fac=0.0d0
11615 costhet_grad(j)=costhet_fac*pep_side(j)
11617 C remember for the final gradient multiply costhet_grad(j)
11618 C for side_chain by factor -2 !
11619 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
11620 C pep_side0pept_group is vector multiplication
11621 pep_side0pept_group=0.0d0
11623 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
11625 cosalfa=(pep_side0pept_group/
11626 & (dist_pep_side*dist_side_calf))
11627 fac_alfa_sin=1.0d0-cosalfa**2
11628 fac_alfa_sin=dsqrt(fac_alfa_sin)
11629 rkprim=fac_alfa_sin*(long-short)+short
11633 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
11635 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
11636 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
11637 & dist_pep_side**2)
11640 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
11641 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
11642 &*(long-short)/fac_alfa_sin*cosalfa/
11643 &((dist_pep_side*dist_side_calf))*
11644 &((side_calf(j))-cosalfa*
11645 &((pep_side(j)/dist_pep_side)*dist_side_calf))
11646 C cosphi_grad_long(j)=0.0d0
11647 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
11648 &*(long-short)/fac_alfa_sin*cosalfa
11649 &/((dist_pep_side*dist_side_calf))*
11651 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
11652 C cosphi_grad_loc(j)=0.0d0
11654 C print *,sinphi,sinthet
11655 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
11658 C now the gradient...
11660 grad_shield(j,i)=grad_shield(j,i)
11661 C gradient po skalowaniu
11662 & +(sh_frac_dist_grad(j)*VofOverlap
11663 C gradient po costhet
11664 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
11665 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
11666 & sinphi/sinthet*costhet*costhet_grad(j)
11667 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
11669 C grad_shield_side is Cbeta sidechain gradient
11670 grad_shield_side(j,ishield_list(i),i)=
11671 & (sh_frac_dist_grad(j)*-2.0d0
11673 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
11674 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
11675 & sinphi/sinthet*costhet*costhet_grad(j)
11676 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
11679 grad_shield_loc(j,ishield_list(i),i)=
11680 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
11681 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
11682 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
11686 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
11688 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
11689 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
11693 C-----------------------------------------------------------------------
11694 C-----------------------------------------------------------
11695 C This subroutine is to mimic the histone like structure but as well can be
11696 C utilizet to nanostructures (infinit) small modification has to be used to
11697 C make it finite (z gradient at the ends has to be changes as well as the x,y
11698 C gradient has to be modified at the ends
11699 C The energy function is Kihara potential
11700 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
11701 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
11702 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
11703 C simple Kihara potential
11704 subroutine calctube(Etube)
11705 implicit real*8 (a-h,o-z)
11706 include 'DIMENSIONS'
11707 include 'COMMON.GEO'
11708 include 'COMMON.VAR'
11709 include 'COMMON.LOCAL'
11710 include 'COMMON.CHAIN'
11711 include 'COMMON.DERIV'
11712 include 'COMMON.NAMES'
11713 include 'COMMON.INTERACT'
11714 include 'COMMON.IOUNITS'
11715 include 'COMMON.CALC'
11716 include 'COMMON.CONTROL'
11717 include 'COMMON.SPLITELE'
11718 include 'COMMON.SBRIDGE'
11719 double precision tub_r,vectube(3),enetube(maxres*2)
11724 C first we calculate the distance from tube center
11725 C first sugare-phosphate group for NARES this would be peptide group
11728 C lets ommit dummy atoms for now
11729 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
11730 C now calculate distance from center of tube and direction vectors
11731 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
11732 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
11733 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
11734 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
11735 vectube(1)=vectube(1)-tubecenter(1)
11736 vectube(2)=vectube(2)-tubecenter(2)
11738 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
11739 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
11741 C as the tube is infinity we do not calculate the Z-vector use of Z
11744 C now calculte the distance
11745 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
11746 C now normalize vector
11747 vectube(1)=vectube(1)/tub_r
11748 vectube(2)=vectube(2)/tub_r
11749 C calculte rdiffrence between r and r0
11752 rdiff6=rdiff**6.0d0
11753 C for vectorization reasons we will sumup at the end to avoid depenence of previous
11754 enetube(i)=pep_aa_tube/rdiff6**2.0d0-pep_bb_tube/rdiff6
11755 C write(iout,*) "TU13",i,rdiff6,enetube(i)
11756 C print *,rdiff,rdiff6,pep_aa_tube
11757 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
11758 C now we calculate gradient
11759 fac=(-12.0d0*pep_aa_tube/rdiff6+
11760 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
11761 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
11764 C now direction of gg_tube vector
11766 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
11767 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
11770 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
11772 C Lets not jump over memory as we use many times iti
11774 C lets ommit dummy atoms for now
11776 C in UNRES uncomment the line below as GLY has no side-chain...
11779 vectube(1)=c(1,i+nres)
11780 vectube(1)=mod(vectube(1),boxxsize)
11781 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
11782 vectube(2)=c(2,i+nres)
11783 vectube(2)=mod(vectube(2),boxysize)
11784 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
11786 vectube(1)=vectube(1)-tubecenter(1)
11787 vectube(2)=vectube(2)-tubecenter(2)
11789 C as the tube is infinity we do not calculate the Z-vector use of Z
11792 C now calculte the distance
11793 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
11794 C now normalize vector
11795 vectube(1)=vectube(1)/tub_r
11796 vectube(2)=vectube(2)/tub_r
11797 C calculte rdiffrence between r and r0
11800 rdiff6=rdiff**6.0d0
11801 C for vectorization reasons we will sumup at the end to avoid depenence of previous
11802 sc_aa_tube=sc_aa_tube_par(iti)
11803 sc_bb_tube=sc_bb_tube_par(iti)
11804 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0-sc_bb_tube/rdiff6
11805 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
11806 C now we calculate gradient
11807 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff+
11808 & 6.0d0*sc_bb_tube/rdiff6/rdiff
11809 C now direction of gg_tube vector
11811 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
11812 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
11816 Etube=Etube+enetube(i)
11818 C print *,"ETUBE", etube
11821 C TO DO 1) add to total energy
11822 C 2) add to gradient summation
11823 C 3) add reading parameters (AND of course oppening of PARAM file)
11824 C 4) add reading the center of tube
11826 C 6) add to zerograd
11828 C-----------------------------------------------------------------------
11829 C-----------------------------------------------------------
11830 C This subroutine is to mimic the histone like structure but as well can be
11831 C utilizet to nanostructures (infinit) small modification has to be used to
11832 C make it finite (z gradient at the ends has to be changes as well as the x,y
11833 C gradient has to be modified at the ends
11834 C The energy function is Kihara potential
11835 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
11836 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
11837 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
11838 C simple Kihara potential
11839 subroutine calctube2(Etube)
11840 implicit real*8 (a-h,o-z)
11841 include 'DIMENSIONS'
11842 include 'COMMON.GEO'
11843 include 'COMMON.VAR'
11844 include 'COMMON.LOCAL'
11845 include 'COMMON.CHAIN'
11846 include 'COMMON.DERIV'
11847 include 'COMMON.NAMES'
11848 include 'COMMON.INTERACT'
11849 include 'COMMON.IOUNITS'
11850 include 'COMMON.CALC'
11851 include 'COMMON.CONTROL'
11852 include 'COMMON.SPLITELE'
11853 include 'COMMON.SBRIDGE'
11854 double precision tub_r,vectube(3),enetube(maxres*2)
11859 C first we calculate the distance from tube center
11860 C first sugare-phosphate group for NARES this would be peptide group
11863 C lets ommit dummy atoms for now
11864 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
11865 C now calculate distance from center of tube and direction vectors
11866 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
11867 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
11868 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
11869 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
11870 vectube(1)=vectube(1)-tubecenter(1)
11871 vectube(2)=vectube(2)-tubecenter(2)
11873 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
11874 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
11876 C as the tube is infinity we do not calculate the Z-vector use of Z
11879 C now calculte the distance
11880 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
11881 C now normalize vector
11882 vectube(1)=vectube(1)/tub_r
11883 vectube(2)=vectube(2)/tub_r
11884 C calculte rdiffrence between r and r0
11887 rdiff6=rdiff**6.0d0
11888 C for vectorization reasons we will sumup at the end to avoid depenence of previous
11889 enetube(i)=pep_aa_tube/rdiff6**2.0d0-pep_bb_tube/rdiff6
11890 C write(iout,*) "TU13",i,rdiff6,enetube(i)
11891 C print *,rdiff,rdiff6,pep_aa_tube
11892 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
11893 C now we calculate gradient
11894 fac=(-12.0d0*pep_aa_tube/rdiff6+
11895 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
11896 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
11899 C now direction of gg_tube vector
11901 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
11902 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
11905 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
11907 C Lets not jump over memory as we use many times iti
11909 C lets ommit dummy atoms for now
11911 C in UNRES uncomment the line below as GLY has no side-chain...
11914 vectube(1)=c(1,i+nres)
11915 vectube(1)=mod(vectube(1),boxxsize)
11916 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
11917 vectube(2)=c(2,i+nres)
11918 vectube(2)=mod(vectube(2),boxysize)
11919 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
11921 vectube(1)=vectube(1)-tubecenter(1)
11922 vectube(2)=vectube(2)-tubecenter(2)
11923 C THIS FRAGMENT MAKES TUBE FINITE
11924 positi=(mod(c(3,i+nres),boxzsize))
11925 if (positi.le.0) positi=positi+boxzsize
11926 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
11927 c for each residue check if it is in lipid or lipid water border area
11928 C respos=mod(c(3,i+nres),boxzsize)
11929 print *,positi,bordtubebot,buftubebot,bordtubetop
11930 if ((positi.gt.bordtubebot)
11931 & .and.(positi.lt.bordtubetop)) then
11932 C the energy transfer exist
11933 if (positi.lt.buftubebot) then
11935 & ((positi-bordtubebot)/tubebufthick)
11936 C lipbufthick is thickenes of lipid buffore
11937 sstube=sscalelip(fracinbuf)
11938 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
11939 print *,ssgradtube, sstube,tubetranene(itype(i))
11940 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
11941 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
11942 C &+ssgradtube*tubetranene(itype(i))
11943 C gg_tube(3,i-1)= gg_tube(3,i-1)
11944 C &+ssgradtube*tubetranene(itype(i))
11945 C print *,"doing sccale for lower part"
11946 elseif (positi.gt.buftubetop) then
11948 &((bordtubetop-positi)/tubebufthick)
11949 sstube=sscalelip(fracinbuf)
11950 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
11951 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
11952 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
11953 C &+ssgradtube*tubetranene(itype(i))
11954 C gg_tube(3,i-1)= gg_tube(3,i-1)
11955 C &+ssgradtube*tubetranene(itype(i))
11956 C print *, "doing sscalefor top part",sslip,fracinbuf
11960 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
11961 C print *,"I am in true lipid"
11967 endif ! if in lipid or buffor
11968 CEND OF FINITE FRAGMENT
11969 C as the tube is infinity we do not calculate the Z-vector use of Z
11972 C now calculte the distance
11973 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
11974 C now normalize vector
11975 vectube(1)=vectube(1)/tub_r
11976 vectube(2)=vectube(2)/tub_r
11977 C calculte rdiffrence between r and r0
11980 rdiff6=rdiff**6.0d0
11981 C for vectorization reasons we will sumup at the end to avoid depenence of previous
11982 sc_aa_tube=sc_aa_tube_par(iti)
11983 sc_bb_tube=sc_bb_tube_par(iti)
11984 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0-sc_bb_tube/rdiff6)
11985 & *sstube+enetube(i+nres)
11986 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
11987 C now we calculate gradient
11988 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff+
11989 & 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
11990 C now direction of gg_tube vector
11992 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
11993 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
11995 gg_tube_SC(3,i)=gg_tube_SC(3,i)
11996 &+ssgradtube*enetube(i+nres)/sstube
11997 gg_tube(3,i-1)= gg_tube(3,i-1)
11998 &+ssgradtube*enetube(i+nres)/sstube
12002 Etube=Etube+enetube(i)
12004 C print *,"ETUBE", etube
12007 C TO DO 1) add to total energy
12008 C 2) add to gradient summation
12009 C 3) add reading parameters (AND of course oppening of PARAM file)
12010 C 4) add reading the center of tube
12012 C 6) add to zerograd