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 integer status(MPI_STATUS_SIZE)
16 include 'COMMON.SETUP'
17 include 'COMMON.IOUNITS'
18 double precision energia(0:n_ene)
19 include 'COMMON.LOCAL'
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
27 include 'COMMON.CONTROL'
28 include 'COMMON.TIME1'
29 include 'COMMON.SPLITELE'
30 include 'COMMON.SHIELD'
31 double precision fac_shieldbuf(maxres),
32 & grad_shield_locbuf(3,maxcontsshi,-1:maxres),
33 & grad_shield_sidebuf(3,maxcontsshi,-1:maxres),
34 & grad_shieldbuf(3,-1:maxres)
35 integer ishield_listbuf(maxres),
36 &shield_listbuf(maxcontsshi,maxres)
38 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
39 c & " nfgtasks",nfgtasks
40 if (nfgtasks.gt.1) then
42 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
43 if (fg_rank.eq.0) then
44 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
45 c print *,"Processor",myrank," BROADCAST iorder"
46 C FG master sets up the WEIGHTS_ array which will be broadcast to the
47 C FG slaves as WEIGHTS array.
69 C FG Master broadcasts the WEIGHTS_ array
70 call MPI_Bcast(weights_(1),n_ene,
71 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
73 C FG slaves receive the WEIGHTS array
74 call MPI_Bcast(weights(1),n_ene,
75 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
97 time_Bcast=time_Bcast+MPI_Wtime()-time00
98 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
99 c call chainbuild_cart
101 c print *,'Processor',myrank,' calling etotal ipot=',ipot
102 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
104 c if (modecalc.eq.12.or.modecalc.eq.14) then
105 c call int_from_cart1(.false.)
112 C Compute the side-chain and electrostatic interaction energy
115 goto (101,102,103,104,105,106) ipot
116 C Lennard-Jones potential.
118 cd print '(a)','Exit ELJ'
120 C Lennard-Jones-Kihara potential (shifted).
123 C Berne-Pechukas potential (dilated LJ, angular dependence).
126 C Gay-Berne potential (shifted LJ, angular dependence).
128 C print *,"bylem w egb"
130 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
133 C Soft-sphere potential
134 106 call e_softsphere(evdw)
136 C Calculate electrostatic (H-bonding) energy of the main chain.
140 cmc Sep-06: egb takes care of dynamic ss bonds too
142 c if (dyn_ss) call dyn_set_nss
144 c print *,"Processor",myrank," computed USCSC"
150 time_vec=time_vec+MPI_Wtime()-time01
152 C Introduction of shielding effect first for each peptide group
153 C the shielding factor is set this factor is describing how each
154 C peptide group is shielded by side-chains
155 C the matrix - shield_fac(i) the i index describe the ith between i and i+1
156 C write (iout,*) "shield_mode",shield_mode
157 if (shield_mode.eq.1) then
159 else if (shield_mode.eq.2) then
161 if (nfgtasks.gt.1) then
164 write(iout,*) "befor reduce fac_shield reduce"
166 write(2,*) "fac",itype(i),fac_shield(i),grad_shield(1,i)
167 write(2,*) "list", shield_list(1,i),ishield_list(i),
168 & grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
171 call MPI_Allgatherv(fac_shield(ivec_start),
172 & ivec_count(fg_rank1),
173 & MPI_DOUBLE_PRECISION,fac_shieldbuf(1),ivec_count(0),
175 & MPI_DOUBLE_PRECISION,FG_COMM,IERR)
176 call MPI_Allgatherv(shield_list(1,ivec_start),
177 & ivec_count(fg_rank1),
178 & MPI_I50,shield_listbuf(1,1),ivec_count(0),
180 & MPI_I50,FG_COMM,IERR)
181 call MPI_Allgatherv(ishield_list(ivec_start),
182 & ivec_count(fg_rank1),
183 & MPI_INTEGER,ishield_listbuf(1),ivec_count(0),
185 & MPI_INTEGER,FG_COMM,IERR)
186 call MPI_Allgatherv(grad_shield(1,ivec_start),
187 & ivec_count(fg_rank1),
188 & MPI_UYZ,grad_shieldbuf(1,1),ivec_count(0),
190 & MPI_UYZ,FG_COMM,IERR)
191 call MPI_Allgatherv(grad_shield_side(1,1,ivec_start),
192 & ivec_count(fg_rank1),
193 & MPI_SHI,grad_shield_sidebuf(1,1,1),ivec_count(0),
195 & MPI_SHI,FG_COMM,IERR)
196 call MPI_Allgatherv(grad_shield_loc(1,1,ivec_start),
197 & ivec_count(fg_rank1),
198 & MPI_SHI,grad_shield_locbuf(1,1,1),ivec_count(0),
200 & MPI_SHI,FG_COMM,IERR)
202 fac_shield(i)=fac_shieldbuf(i)
203 ishield_list(i)=ishield_listbuf(i)
205 grad_shield(j,i)=grad_shieldbuf(j,i)
207 do j=1,ishield_list(i)
208 shield_list(j,i)=shield_listbuf(j,i)
210 grad_shield_loc(k,j,i)=grad_shield_locbuf(k,j,i)
211 grad_shield_side(k,j,i)=grad_shield_sidebuf(k,j,i)
216 write(iout,*) "after reduce fac_shield reduce"
218 write(2,*) "fac",itype(i),fac_shield(i),grad_shield(1,i)
219 write(2,*) "list", shield_list(1,i),ishield_list(i),
220 & grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
227 write(iout,*) fac_shield(i),ishield_list(i),i,grad_shield(1,i)
228 do j=1,ishield_list(i)
229 write(iout,*) "grad", grad_shield_side(1,j,i),
230 & grad_shield_loc(1,j,i)
235 c print *,"Processor",myrank," left VEC_AND_DERIV"
238 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
239 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
240 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
241 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
243 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
244 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
245 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
246 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
248 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
257 write (iout,*) "Soft-spheer ELEC potential"
258 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
261 c print *,"Processor",myrank," computed UELEC"
263 C Calculate excluded-volume interaction energy between peptide groups
268 call escp(evdw2,evdw2_14)
274 c write (iout,*) "Soft-sphere SCP potential"
275 call escp_soft_sphere(evdw2,evdw2_14)
278 c Calculate the bond-stretching energy
282 C Calculate the disulfide-bridge and other energy and the contributions
283 C from other distance constraints.
284 cd print *,'Calling EHPB'
286 cd print *,'EHPB exitted succesfully.'
288 C Calculate the virtual-bond-angle energy.
290 if (wang.gt.0d0) then
291 if ((tor_mode.eq.0).or.(tor_mode.eq.2)) then
292 call ebend(ebe,ethetacnstr)
294 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
296 if ((tor_mode.eq.1).or.(tor_mode.eq.2)) then
297 call ebend_kcc(ebe,ethetacnstr)
303 c print *,"Processor",myrank," computed UB"
305 C Calculate the SC local energy.
307 C print *,"TU DOCHODZE?"
309 c print *,"Processor",myrank," computed USC"
311 C Calculate the virtual-bond torsional energy.
313 cd print *,'nterm=',nterm
314 C print *,"tor",tor_mode
316 if ((tor_mode.eq.0).or.(tor_mode.eq.2)) then
317 call etor(etors,edihcnstr)
319 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
321 if ((tor_mode.eq.1).or.(tor_mode.eq.2)) then
322 call etor_kcc(etors,edihcnstr)
328 c print *,"Processor",myrank," computed Utor"
330 C 6/23/01 Calculate double-torsional energy
332 if ((wtor_d.gt.0).and.((tor_mode.eq.0).or.(tor_mode.eq.2))) then
337 c print *,"Processor",myrank," computed Utord"
339 C 21/5/07 Calculate local sicdechain correlation energy
341 if (wsccor.gt.0.0d0) then
342 call eback_sc_corr(esccor)
346 C print *,"PRZED MULIt"
347 c print *,"Processor",myrank," computed Usccorr"
349 C 12/1/95 Multi-body terms
353 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
354 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
355 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
356 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
357 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
364 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
365 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
366 cd write (iout,*) "multibody_hb ecorr",ecorr
368 c print *,"Processor",myrank," computed Ucorr"
370 C If performing constraint dynamics, call the constraint energy
371 C after the equilibration time
372 if(usampl.and.totT.gt.eq_time) then
379 C 01/27/2015 added by adasko
380 C the energy component below is energy transfer into lipid environment
381 C based on partition function
382 C print *,"przed lipidami"
383 if (wliptran.gt.0) then
384 call Eliptransfer(eliptran)
388 C print *,"za lipidami"
389 if (AFMlog.gt.0) then
390 call AFMforce(Eafmforce)
391 else if (selfguide.gt.0) then
392 call AFMvel(Eafmforce)
394 if (TUBElog.eq.1) then
395 C print *,"just before call"
397 elseif (TUBElog.eq.2) then
398 call calctube2(Etube)
399 elseif (TUBElog.eq.3) then
406 time_enecalc=time_enecalc+MPI_Wtime()-time00
408 c print *,"Processor",myrank," computed Uconstr"
417 energia(2)=evdw2-evdw2_14
434 energia(8)=eello_turn3
435 energia(9)=eello_turn4
442 energia(19)=edihcnstr
444 energia(20)=Uconst+Uconst_back
447 energia(23)=Eafmforce
448 energia(24)=ethetacnstr
450 c Here are the energies showed per procesor if the are more processors
451 c per molecule then we sum it up in sum_energy subroutine
452 c print *," Processor",myrank," calls SUM_ENERGY"
453 call sum_energy(energia,.true.)
454 if (dyn_ss) call dyn_set_nss
455 c print *," Processor",myrank," left SUM_ENERGY"
457 time_sumene=time_sumene+MPI_Wtime()-time00
461 c-------------------------------------------------------------------------------
462 subroutine sum_energy(energia,reduce)
463 implicit real*8 (a-h,o-z)
468 cMS$ATTRIBUTES C :: proc_proc
474 include 'COMMON.SETUP'
475 include 'COMMON.IOUNITS'
476 double precision energia(0:n_ene),enebuff(0:n_ene+1)
477 include 'COMMON.FFIELD'
478 include 'COMMON.DERIV'
479 include 'COMMON.INTERACT'
480 include 'COMMON.SBRIDGE'
481 include 'COMMON.CHAIN'
483 include 'COMMON.CONTROL'
484 include 'COMMON.TIME1'
487 if (nfgtasks.gt.1 .and. reduce) then
489 write (iout,*) "energies before REDUCE"
490 call enerprint(energia)
494 enebuff(i)=energia(i)
497 call MPI_Barrier(FG_COMM,IERR)
498 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
500 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
501 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
503 write (iout,*) "energies after REDUCE"
504 call enerprint(energia)
507 time_Reduce=time_Reduce+MPI_Wtime()-time00
509 if (fg_rank.eq.0) then
513 evdw2=energia(2)+energia(18)
529 eello_turn3=energia(8)
530 eello_turn4=energia(9)
537 edihcnstr=energia(19)
542 Eafmforce=energia(23)
543 ethetacnstr=energia(24)
546 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
547 & +wang*ebe+wtor*etors+wscloc*escloc
548 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
549 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
550 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
551 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+Eafmforce
552 & +ethetacnstr+wtube*Etube
554 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
555 & +wang*ebe+wtor*etors+wscloc*escloc
556 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
557 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
558 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
559 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
561 & +ethetacnstr+wtube*Etube
567 if (isnan(etot).ne.0) energia(0)=1.0d+99
569 if (isnan(etot)) energia(0)=1.0d+99
574 idumm=proc_proc(etot,i)
576 call proc_proc(etot,i)
578 if(i.eq.1)energia(0)=1.0d+99
585 c-------------------------------------------------------------------------------
586 subroutine sum_gradient
587 implicit real*8 (a-h,o-z)
592 cMS$ATTRIBUTES C :: proc_proc
598 double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
599 & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
600 & ,gloc_scbuf(3,-1:maxres)
601 include 'COMMON.SETUP'
602 include 'COMMON.IOUNITS'
603 include 'COMMON.FFIELD'
604 include 'COMMON.DERIV'
605 include 'COMMON.INTERACT'
606 include 'COMMON.SBRIDGE'
607 include 'COMMON.CHAIN'
609 include 'COMMON.CONTROL'
610 include 'COMMON.TIME1'
611 include 'COMMON.MAXGRAD'
612 include 'COMMON.SCCOR'
617 write (iout,*) "sum_gradient gvdwc, gvdwx"
619 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
620 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
625 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
626 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
627 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
630 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
631 C in virtual-bond-vector coordinates
634 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
636 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
637 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
639 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
641 c write (iout,'(i5,3f10.5,2x,f10.5)')
642 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
644 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
646 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
647 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
655 gradbufc(j,i)=wsc*gvdwc(j,i)+
656 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
657 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
658 & wel_loc*gel_loc_long(j,i)+
659 & wcorr*gradcorr_long(j,i)+
660 & wcorr5*gradcorr5_long(j,i)+
661 & wcorr6*gradcorr6_long(j,i)+
662 & wturn6*gcorr6_turn_long(j,i)+
664 & +wliptran*gliptranc(j,i)
666 & +welec*gshieldc(j,i)
667 & +wcorr*gshieldc_ec(j,i)
668 & +wturn3*gshieldc_t3(j,i)
669 & +wturn4*gshieldc_t4(j,i)
670 & +wel_loc*gshieldc_ll(j,i)
671 & +wtube*gg_tube(j,i)
679 C print *,"KUPA2",gradbufc(j,i),wsc*gvdwc(j,i),
680 C & wscp*gvdwc_scp(j,i),gvdwc_scpp(j,i),
681 C & welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i),
682 C & wel_loc*gel_loc_long(j,i),
683 C & wcorr*gradcorr_long(j,i),
684 C & wcorr5*gradcorr5_long(j,i),
685 C & wcorr6*gradcorr6_long(j,i),
686 C & wturn6*gcorr6_turn_long(j,i),
687 C & wstrain*ghpbc(j,i)
688 C & ,wliptran*gliptranc(j,i)
690 C & ,welec*gshieldc(j,i)
691 C & ,wcorr*gshieldc_ec(j,i)
692 C & ,wturn3*gshieldc_t3(j,i)
693 C & ,wturn4*gshieldc_t4(j,i)
694 C & ,wel_loc*gshieldc_ll(j,i)
695 C & ,wtube*gg_tube(j,i)
699 gradbufc(j,i)=wsc*gvdwc(j,i)+
700 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
701 & welec*gelc_long(j,i)+
703 & wel_loc*gel_loc_long(j,i)+
704 & wcorr*gradcorr_long(j,i)+
705 & wcorr5*gradcorr5_long(j,i)+
706 & wcorr6*gradcorr6_long(j,i)+
707 & wturn6*gcorr6_turn_long(j,i)+
709 & +wliptran*gliptranc(j,i)
711 & +welec*gshieldc(j,i)
712 & +wcorr*gshieldc_ec(j,i)
713 & +wturn4*gshieldc_t4(j,i)
714 & +wel_loc*gshieldc_ll(j,i)
715 & +wtube*gg_tube(j,i)
723 if (nfgtasks.gt.1) then
726 write (iout,*) "gradbufc before allreduce"
728 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
734 gradbufc_sum(j,i)=gradbufc(j,i)
737 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
738 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
739 c time_reduce=time_reduce+MPI_Wtime()-time00
741 c write (iout,*) "gradbufc_sum after allreduce"
743 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
748 c time_allreduce=time_allreduce+MPI_Wtime()-time00
756 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
757 write (iout,*) (i," jgrad_start",jgrad_start(i),
758 & " jgrad_end ",jgrad_end(i),
759 & i=igrad_start,igrad_end)
762 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
763 c do not parallelize this part.
765 c do i=igrad_start,igrad_end
766 c do j=jgrad_start(i),jgrad_end(i)
768 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
773 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
777 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
781 write (iout,*) "gradbufc after summing"
783 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
790 write (iout,*) "gradbufc"
792 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
798 gradbufc_sum(j,i)=gradbufc(j,i)
803 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
807 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
812 c gradbufc(k,i)=0.0d0
816 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
821 write (iout,*) "gradbufc after summing"
823 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
831 gradbufc(k,nres)=0.0d0
836 C print *,gradbufc(1,13)
837 C print *,welec*gelc(1,13)
838 C print *,wel_loc*gel_loc(1,13)
839 C print *,0.5d0*(wscp*gvdwc_scpp(1,13))
840 C print *,welec*gelc_long(1,13)+wvdwpp*gvdwpp(1,13)
841 C print *,wel_loc*gel_loc_long(1,13)
842 C print *,gradafm(1,13),"AFM"
843 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
844 & wel_loc*gel_loc(j,i)+
845 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
846 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
847 & wel_loc*gel_loc_long(j,i)+
848 & wcorr*gradcorr_long(j,i)+
849 & wcorr5*gradcorr5_long(j,i)+
850 & wcorr6*gradcorr6_long(j,i)+
851 & wturn6*gcorr6_turn_long(j,i))+
853 & wcorr*gradcorr(j,i)+
854 & wturn3*gcorr3_turn(j,i)+
855 & wturn4*gcorr4_turn(j,i)+
856 & wcorr5*gradcorr5(j,i)+
857 & wcorr6*gradcorr6(j,i)+
858 & wturn6*gcorr6_turn(j,i)+
859 & wsccor*gsccorc(j,i)
860 & +wscloc*gscloc(j,i)
861 & +wliptran*gliptranc(j,i)
863 & +welec*gshieldc(j,i)
864 & +welec*gshieldc_loc(j,i)
865 & +wcorr*gshieldc_ec(j,i)
866 & +wcorr*gshieldc_loc_ec(j,i)
867 & +wturn3*gshieldc_t3(j,i)
868 & +wturn3*gshieldc_loc_t3(j,i)
869 & +wturn4*gshieldc_t4(j,i)
870 & +wturn4*gshieldc_loc_t4(j,i)
871 & +wel_loc*gshieldc_ll(j,i)
872 & +wel_loc*gshieldc_loc_ll(j,i)
873 & +wtube*gg_tube(j,i)
876 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
877 & wel_loc*gel_loc(j,i)+
878 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
879 & welec*gelc_long(j,i)+
880 & wel_loc*gel_loc_long(j,i)+
881 & wcorr*gcorr_long(j,i)+
882 & wcorr5*gradcorr5_long(j,i)+
883 & wcorr6*gradcorr6_long(j,i)+
884 & wturn6*gcorr6_turn_long(j,i))+
886 & wcorr*gradcorr(j,i)+
887 & wturn3*gcorr3_turn(j,i)+
888 & wturn4*gcorr4_turn(j,i)+
889 & wcorr5*gradcorr5(j,i)+
890 & wcorr6*gradcorr6(j,i)+
891 & wturn6*gcorr6_turn(j,i)+
892 & wsccor*gsccorc(j,i)
893 & +wscloc*gscloc(j,i)
894 & +wliptran*gliptranc(j,i)
896 & +welec*gshieldc(j,i)
897 & +welec*gshieldc_loc(j,i)
898 & +wcorr*gshieldc_ec(j,i)
899 & +wcorr*gshieldc_loc_ec(j,i)
900 & +wturn3*gshieldc_t3(j,i)
901 & +wturn3*gshieldc_loc_t3(j,i)
902 & +wturn4*gshieldc_t4(j,i)
903 & +wturn4*gshieldc_loc_t4(j,i)
904 & +wel_loc*gshieldc_ll(j,i)
905 & +wel_loc*gshieldc_loc_ll(j,i)
906 & +wtube*gg_tube(j,i)
910 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
912 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
913 & wsccor*gsccorx(j,i)
914 & +wscloc*gsclocx(j,i)
915 & +wliptran*gliptranx(j,i)
916 & +welec*gshieldx(j,i)
917 & +wcorr*gshieldx_ec(j,i)
918 & +wturn3*gshieldx_t3(j,i)
919 & +wturn4*gshieldx_t4(j,i)
920 & +wel_loc*gshieldx_ll(j,i)
921 & +wtube*gg_tube_sc(j,i)
929 C print *,"KUPA", gradbufc(j,i),welec*gelc(j,i),
930 C & wel_loc*gel_loc(j,i),
931 C & 0.5d0*wscp*gvdwc_scpp(j,i),
932 C & welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i),
933 C & wel_loc*gel_loc_long(j,i),
934 C & wcorr*gradcorr_long(j,i),
935 C & wcorr5*gradcorr5_long(j,i),
936 C & wcorr6*gradcorr6_long(j,i),
937 C & wturn6*gcorr6_turn_long(j,i),
938 C & wbond*gradb(j,i),
939 C & wcorr*gradcorr(j,i),
940 C & wturn3*gcorr3_turn(j,i),
941 C & wturn4*gcorr4_turn(j,i),
942 C & wcorr5*gradcorr5(j,i),
943 C & wcorr6*gradcorr6(j,i),
944 C & wturn6*gcorr6_turn(j,i),
945 C & wsccor*gsccorc(j,i)
946 C & ,wscloc*gscloc(j,i)
947 C & ,wliptran*gliptranc(j,i)
949 C & +welec*gshieldc(j,i)
950 C & +welec*gshieldc_loc(j,i)
951 C & +wcorr*gshieldc_ec(j,i)
952 C & +wcorr*gshieldc_loc_ec(j,i)
953 C & +wturn3*gshieldc_t3(j,i)
954 C & +wturn3*gshieldc_loc_t3(j,i)
955 C & +wturn4*gshieldc_t4(j,i)
956 C & ,wturn4*gshieldc_loc_t4(j,i)
957 C & ,wel_loc*gshieldc_ll(j,i)
958 C & ,wel_loc*gshieldc_loc_ll(j,i)
959 C & ,wtube*gg_tube(j,i)
961 C print *,gg_tube(1,0),"TU3"
963 write (iout,*) "gloc before adding corr"
965 write (iout,*) i,gloc(i,icg)
969 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
970 & +wcorr5*g_corr5_loc(i)
971 & +wcorr6*g_corr6_loc(i)
972 & +wturn4*gel_loc_turn4(i)
973 & +wturn3*gel_loc_turn3(i)
974 & +wturn6*gel_loc_turn6(i)
975 & +wel_loc*gel_loc_loc(i)
978 write (iout,*) "gloc after adding corr"
980 write (iout,*) i,gloc(i,icg)
984 if (nfgtasks.gt.1) then
987 gradbufc(j,i)=gradc(j,i,icg)
988 gradbufx(j,i)=gradx(j,i,icg)
992 glocbuf(i)=gloc(i,icg)
996 write (iout,*) "gloc_sc before reduce"
999 write (iout,*) i,j,gloc_sc(j,i,icg)
1006 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
1010 call MPI_Barrier(FG_COMM,IERR)
1011 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
1013 call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,
1014 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
1015 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
1016 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
1017 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
1018 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
1019 time_reduce=time_reduce+MPI_Wtime()-time00
1020 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
1021 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
1022 time_reduce=time_reduce+MPI_Wtime()-time00
1025 write (iout,*) "gloc_sc after reduce"
1028 write (iout,*) i,j,gloc_sc(j,i,icg)
1034 write (iout,*) "gloc after reduce"
1036 write (iout,*) i,gloc(i,icg)
1041 if (gnorm_check) then
1043 c Compute the maximum elements of the gradient
1053 gcorr3_turn_max=0.0d0
1054 gcorr4_turn_max=0.0d0
1057 gcorr6_turn_max=0.0d0
1067 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
1068 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
1069 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
1070 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
1071 & gvdwc_scp_max=gvdwc_scp_norm
1072 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
1073 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
1074 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
1075 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
1076 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
1077 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
1078 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
1079 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
1080 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
1081 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
1082 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
1083 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
1084 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
1085 & gcorr3_turn(1,i)))
1086 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
1087 & gcorr3_turn_max=gcorr3_turn_norm
1088 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
1089 & gcorr4_turn(1,i)))
1090 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
1091 & gcorr4_turn_max=gcorr4_turn_norm
1092 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
1093 if (gradcorr5_norm.gt.gradcorr5_max)
1094 & gradcorr5_max=gradcorr5_norm
1095 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
1096 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
1097 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
1098 & gcorr6_turn(1,i)))
1099 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
1100 & gcorr6_turn_max=gcorr6_turn_norm
1101 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
1102 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
1103 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
1104 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
1105 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
1106 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
1107 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
1108 if (gradx_scp_norm.gt.gradx_scp_max)
1109 & gradx_scp_max=gradx_scp_norm
1110 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
1111 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
1112 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
1113 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
1114 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
1115 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
1116 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
1117 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
1121 open(istat,file=statname,position="append")
1123 open(istat,file=statname,access="append")
1125 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
1126 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
1127 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
1128 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
1129 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
1130 & gsccorx_max,gsclocx_max
1132 if (gvdwc_max.gt.1.0d4) then
1133 write (iout,*) "gvdwc gvdwx gradb gradbx"
1135 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
1136 & gradb(j,i),gradbx(j,i),j=1,3)
1138 call pdbout(0.0d0,'cipiszcze',iout)
1144 write (iout,*) "gradc gradx gloc"
1146 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
1147 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
1151 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
1155 c-------------------------------------------------------------------------------
1156 subroutine rescale_weights(t_bath)
1157 implicit real*8 (a-h,o-z)
1158 include 'DIMENSIONS'
1159 include 'COMMON.IOUNITS'
1160 include 'COMMON.FFIELD'
1161 include 'COMMON.SBRIDGE'
1162 include 'COMMON.CONTROL'
1163 double precision kfac /2.4d0/
1164 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
1166 c facT=2*temp0/(t_bath+temp0)
1167 if (rescale_mode.eq.0) then
1173 else if (rescale_mode.eq.1) then
1174 facT=kfac/(kfac-1.0d0+t_bath/temp0)
1175 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1176 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1177 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1178 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1179 else if (rescale_mode.eq.2) then
1185 facT=licznik/dlog(dexp(x)+dexp(-x))
1186 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
1187 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
1188 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
1189 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
1191 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1192 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1194 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1198 if (shield_mode.gt.0) then
1199 wscp=weights(2)*fact
1201 wvdwpp=weights(16)*fact
1203 welec=weights(3)*fact
1204 wcorr=weights(4)*fact3
1205 wcorr5=weights(5)*fact4
1206 wcorr6=weights(6)*fact5
1207 wel_loc=weights(7)*fact2
1208 wturn3=weights(8)*fact2
1209 wturn4=weights(9)*fact3
1210 wturn6=weights(10)*fact5
1211 wtor=weights(13)*fact
1212 wtor_d=weights(14)*fact2
1213 wsccor=weights(21)*fact
1217 C------------------------------------------------------------------------
1218 subroutine enerprint(energia)
1219 implicit real*8 (a-h,o-z)
1220 include 'DIMENSIONS'
1221 include 'COMMON.IOUNITS'
1222 include 'COMMON.FFIELD'
1223 include 'COMMON.SBRIDGE'
1225 double precision energia(0:n_ene)
1230 evdw2=energia(2)+energia(18)
1242 eello_turn3=energia(8)
1243 eello_turn4=energia(9)
1244 eello_turn6=energia(10)
1250 edihcnstr=energia(19)
1254 eliptran=energia(22)
1255 Eafmforce=energia(23)
1256 ethetacnstr=energia(24)
1259 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1260 & estr,wbond,ebe,wang,
1261 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1263 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1264 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,
1265 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1268 10 format (/'Virtual-chain energies:'//
1269 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1270 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1271 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1272 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1273 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1274 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1275 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1276 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1277 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1278 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1279 & ' (SS bridges & dist. cnstr.)'/
1280 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1281 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1282 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1283 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1284 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1285 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1286 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1287 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1288 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1289 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1290 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1291 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1292 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1293 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1294 & 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/
1295 & 'ETOT= ',1pE16.6,' (total)')
1298 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1299 & estr,wbond,ebe,wang,
1300 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1302 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1303 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1304 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1307 10 format (/'Virtual-chain energies:'//
1308 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1309 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1310 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1311 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1312 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1313 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1314 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1315 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1316 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1317 & ' (SS bridges & dist. cnstr.)'/
1318 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1319 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1320 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1321 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1322 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1323 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1324 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1325 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1326 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1327 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1328 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1329 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1330 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1331 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1332 & 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/
1333 & 'ETOT= ',1pE16.6,' (total)')
1337 C-----------------------------------------------------------------------
1338 subroutine elj(evdw)
1340 C This subroutine calculates the interaction energy of nonbonded side chains
1341 C assuming the LJ potential of interaction.
1343 implicit real*8 (a-h,o-z)
1344 include 'DIMENSIONS'
1345 parameter (accur=1.0d-10)
1346 include 'COMMON.GEO'
1347 include 'COMMON.VAR'
1348 include 'COMMON.LOCAL'
1349 include 'COMMON.CHAIN'
1350 include 'COMMON.DERIV'
1351 include 'COMMON.INTERACT'
1352 include 'COMMON.TORSION'
1353 include 'COMMON.SBRIDGE'
1354 include 'COMMON.NAMES'
1355 include 'COMMON.IOUNITS'
1356 include 'COMMON.CONTACTS'
1358 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1360 do i=iatsc_s,iatsc_e
1361 itypi=iabs(itype(i))
1362 if (itypi.eq.ntyp1) cycle
1363 itypi1=iabs(itype(i+1))
1370 C Calculate SC interaction energy.
1372 do iint=1,nint_gr(i)
1373 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1374 cd & 'iend=',iend(i,iint)
1375 do j=istart(i,iint),iend(i,iint)
1376 itypj=iabs(itype(j))
1377 if (itypj.eq.ntyp1) cycle
1381 C Change 12/1/95 to calculate four-body interactions
1382 rij=xj*xj+yj*yj+zj*zj
1384 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1385 eps0ij=eps(itypi,itypj)
1387 C have you changed here?
1391 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1392 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1393 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1394 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1395 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1396 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1399 C Calculate the components of the gradient in DC and X
1401 fac=-rrij*(e1+evdwij)
1406 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1407 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1408 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1409 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1413 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1417 C 12/1/95, revised on 5/20/97
1419 C Calculate the contact function. The ith column of the array JCONT will
1420 C contain the numbers of atoms that make contacts with the atom I (of numbers
1421 C greater than I). The arrays FACONT and GACONT will contain the values of
1422 C the contact function and its derivative.
1424 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1425 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1426 C Uncomment next line, if the correlation interactions are contact function only
1427 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1429 sigij=sigma(itypi,itypj)
1430 r0ij=rs0(itypi,itypj)
1432 C Check whether the SC's are not too far to make a contact.
1435 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1436 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1438 if (fcont.gt.0.0D0) then
1439 C If the SC-SC distance if close to sigma, apply spline.
1440 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1441 cAdam & fcont1,fprimcont1)
1442 cAdam fcont1=1.0d0-fcont1
1443 cAdam if (fcont1.gt.0.0d0) then
1444 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1445 cAdam fcont=fcont*fcont1
1447 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1448 cga eps0ij=1.0d0/dsqrt(eps0ij)
1450 cga gg(k)=gg(k)*eps0ij
1452 cga eps0ij=-evdwij*eps0ij
1453 C Uncomment for AL's type of SC correlation interactions.
1454 cadam eps0ij=-evdwij
1455 num_conti=num_conti+1
1456 jcont(num_conti,i)=j
1457 facont(num_conti,i)=fcont*eps0ij
1458 fprimcont=eps0ij*fprimcont/rij
1460 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1461 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1462 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1463 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1464 gacont(1,num_conti,i)=-fprimcont*xj
1465 gacont(2,num_conti,i)=-fprimcont*yj
1466 gacont(3,num_conti,i)=-fprimcont*zj
1467 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1468 cd write (iout,'(2i3,3f10.5)')
1469 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1475 num_cont(i)=num_conti
1479 gvdwc(j,i)=expon*gvdwc(j,i)
1480 gvdwx(j,i)=expon*gvdwx(j,i)
1483 C******************************************************************************
1487 C To save time, the factor of EXPON has been extracted from ALL components
1488 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1491 C******************************************************************************
1494 C-----------------------------------------------------------------------------
1495 subroutine eljk(evdw)
1497 C This subroutine calculates the interaction energy of nonbonded side chains
1498 C assuming the LJK potential of interaction.
1500 implicit real*8 (a-h,o-z)
1501 include 'DIMENSIONS'
1502 include 'COMMON.GEO'
1503 include 'COMMON.VAR'
1504 include 'COMMON.LOCAL'
1505 include 'COMMON.CHAIN'
1506 include 'COMMON.DERIV'
1507 include 'COMMON.INTERACT'
1508 include 'COMMON.IOUNITS'
1509 include 'COMMON.NAMES'
1512 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1514 do i=iatsc_s,iatsc_e
1515 itypi=iabs(itype(i))
1516 if (itypi.eq.ntyp1) cycle
1517 itypi1=iabs(itype(i+1))
1522 C Calculate SC interaction energy.
1524 do iint=1,nint_gr(i)
1525 do j=istart(i,iint),iend(i,iint)
1526 itypj=iabs(itype(j))
1527 if (itypj.eq.ntyp1) cycle
1531 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1532 fac_augm=rrij**expon
1533 e_augm=augm(itypi,itypj)*fac_augm
1534 r_inv_ij=dsqrt(rrij)
1536 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1537 fac=r_shift_inv**expon
1538 C have you changed here?
1542 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1543 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1544 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1545 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1546 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1547 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1548 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1551 C Calculate the components of the gradient in DC and X
1553 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1558 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1559 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1560 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1561 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1565 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1573 gvdwc(j,i)=expon*gvdwc(j,i)
1574 gvdwx(j,i)=expon*gvdwx(j,i)
1579 C-----------------------------------------------------------------------------
1580 subroutine ebp(evdw)
1582 C This subroutine calculates the interaction energy of nonbonded side chains
1583 C assuming the Berne-Pechukas potential of interaction.
1585 implicit real*8 (a-h,o-z)
1586 include 'DIMENSIONS'
1587 include 'COMMON.GEO'
1588 include 'COMMON.VAR'
1589 include 'COMMON.LOCAL'
1590 include 'COMMON.CHAIN'
1591 include 'COMMON.DERIV'
1592 include 'COMMON.NAMES'
1593 include 'COMMON.INTERACT'
1594 include 'COMMON.IOUNITS'
1595 include 'COMMON.CALC'
1596 common /srutu/ icall
1597 c double precision rrsave(maxdim)
1600 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1602 c if (icall.eq.0) then
1608 do i=iatsc_s,iatsc_e
1609 itypi=iabs(itype(i))
1610 if (itypi.eq.ntyp1) cycle
1611 itypi1=iabs(itype(i+1))
1615 dxi=dc_norm(1,nres+i)
1616 dyi=dc_norm(2,nres+i)
1617 dzi=dc_norm(3,nres+i)
1618 c dsci_inv=dsc_inv(itypi)
1619 dsci_inv=vbld_inv(i+nres)
1621 C Calculate SC interaction energy.
1623 do iint=1,nint_gr(i)
1624 do j=istart(i,iint),iend(i,iint)
1626 itypj=iabs(itype(j))
1627 if (itypj.eq.ntyp1) cycle
1628 c dscj_inv=dsc_inv(itypj)
1629 dscj_inv=vbld_inv(j+nres)
1630 chi1=chi(itypi,itypj)
1631 chi2=chi(itypj,itypi)
1638 alf12=0.5D0*(alf1+alf2)
1639 C For diagnostics only!!!
1652 dxj=dc_norm(1,nres+j)
1653 dyj=dc_norm(2,nres+j)
1654 dzj=dc_norm(3,nres+j)
1655 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1656 cd if (icall.eq.0) then
1662 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1664 C Calculate whole angle-dependent part of epsilon and contributions
1665 C to its derivatives
1666 C have you changed here?
1667 fac=(rrij*sigsq)**expon2
1670 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1671 eps2der=evdwij*eps3rt
1672 eps3der=evdwij*eps2rt
1673 evdwij=evdwij*eps2rt*eps3rt
1676 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1678 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1679 cd & restyp(itypi),i,restyp(itypj),j,
1680 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1681 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1682 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1685 C Calculate gradient components.
1686 e1=e1*eps1*eps2rt**2*eps3rt**2
1687 fac=-expon*(e1+evdwij)
1690 C Calculate radial part of the gradient
1694 C Calculate the angular part of the gradient and sum add the contributions
1695 C to the appropriate components of the Cartesian gradient.
1703 C-----------------------------------------------------------------------------
1704 subroutine egb(evdw)
1706 C This subroutine calculates the interaction energy of nonbonded side chains
1707 C assuming the Gay-Berne potential of interaction.
1709 implicit real*8 (a-h,o-z)
1710 include 'DIMENSIONS'
1711 include 'COMMON.GEO'
1712 include 'COMMON.VAR'
1713 include 'COMMON.LOCAL'
1714 include 'COMMON.CHAIN'
1715 include 'COMMON.DERIV'
1716 include 'COMMON.NAMES'
1717 include 'COMMON.INTERACT'
1718 include 'COMMON.IOUNITS'
1719 include 'COMMON.CALC'
1720 include 'COMMON.CONTROL'
1721 include 'COMMON.SPLITELE'
1722 include 'COMMON.SBRIDGE'
1724 integer xshift,yshift,zshift
1727 ccccc energy_dec=.false.
1728 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1731 c if (icall.eq.0) lprn=.false.
1733 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1734 C we have the original box)
1738 do i=iatsc_s,iatsc_e
1739 itypi=iabs(itype(i))
1740 if (itypi.eq.ntyp1) cycle
1741 itypi1=iabs(itype(i+1))
1745 C Return atom into box, boxxsize is size of box in x dimension
1747 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1748 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1749 C Condition for being inside the proper box
1750 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1751 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1755 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1756 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1757 C Condition for being inside the proper box
1758 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1759 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1763 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1764 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1765 C Condition for being inside the proper box
1766 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1767 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1771 if (xi.lt.0) xi=xi+boxxsize
1773 if (yi.lt.0) yi=yi+boxysize
1775 if (zi.lt.0) zi=zi+boxzsize
1776 C define scaling factor for lipids
1778 C if (positi.le.0) positi=positi+boxzsize
1780 C first for peptide groups
1781 c for each residue check if it is in lipid or lipid water border area
1782 if ((zi.gt.bordlipbot)
1783 &.and.(zi.lt.bordliptop)) then
1784 C the energy transfer exist
1785 if (zi.lt.buflipbot) then
1786 C what fraction I am in
1788 & ((zi-bordlipbot)/lipbufthick)
1789 C lipbufthick is thickenes of lipid buffore
1790 sslipi=sscalelip(fracinbuf)
1791 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1792 elseif (zi.gt.bufliptop) then
1793 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1794 sslipi=sscalelip(fracinbuf)
1795 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1805 C xi=xi+xshift*boxxsize
1806 C yi=yi+yshift*boxysize
1807 C zi=zi+zshift*boxzsize
1809 dxi=dc_norm(1,nres+i)
1810 dyi=dc_norm(2,nres+i)
1811 dzi=dc_norm(3,nres+i)
1812 c dsci_inv=dsc_inv(itypi)
1813 dsci_inv=vbld_inv(i+nres)
1814 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1815 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1817 C Calculate SC interaction energy.
1819 do iint=1,nint_gr(i)
1820 do j=istart(i,iint),iend(i,iint)
1821 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1823 c write(iout,*) "PRZED ZWYKLE", evdwij
1824 call dyn_ssbond_ene(i,j,evdwij)
1825 c write(iout,*) "PO ZWYKLE", evdwij
1828 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1829 & 'evdw',i,j,evdwij,' ss'
1830 C triple bond artifac removal
1831 do k=j+1,iend(i,iint)
1832 C search over all next residues
1833 if (dyn_ss_mask(k)) then
1834 C check if they are cysteins
1835 C write(iout,*) 'k=',k
1837 c write(iout,*) "PRZED TRI", evdwij
1838 evdwij_przed_tri=evdwij
1839 call triple_ssbond_ene(i,j,k,evdwij)
1840 c if(evdwij_przed_tri.ne.evdwij) then
1841 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1844 c write(iout,*) "PO TRI", evdwij
1845 C call the energy function that removes the artifical triple disulfide
1846 C bond the soubroutine is located in ssMD.F
1848 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1849 & 'evdw',i,j,evdwij,'tss'
1850 endif!dyn_ss_mask(k)
1854 itypj=iabs(itype(j))
1855 if (itypj.eq.ntyp1) cycle
1856 c dscj_inv=dsc_inv(itypj)
1857 dscj_inv=vbld_inv(j+nres)
1858 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1859 c & 1.0d0/vbld(j+nres)
1860 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1861 sig0ij=sigma(itypi,itypj)
1862 chi1=chi(itypi,itypj)
1863 chi2=chi(itypj,itypi)
1870 alf12=0.5D0*(alf1+alf2)
1871 C For diagnostics only!!!
1884 C Return atom J into box the original box
1886 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1887 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1888 C Condition for being inside the proper box
1889 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1890 c & (xj.lt.((-0.5d0)*boxxsize))) then
1894 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1895 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1896 C Condition for being inside the proper box
1897 c if ((yj.gt.((0.5d0)*boxysize)).or.
1898 c & (yj.lt.((-0.5d0)*boxysize))) then
1902 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1903 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1904 C Condition for being inside the proper box
1905 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1906 c & (zj.lt.((-0.5d0)*boxzsize))) then
1910 if (xj.lt.0) xj=xj+boxxsize
1912 if (yj.lt.0) yj=yj+boxysize
1914 if (zj.lt.0) zj=zj+boxzsize
1915 if ((zj.gt.bordlipbot)
1916 &.and.(zj.lt.bordliptop)) then
1917 C the energy transfer exist
1918 if (zj.lt.buflipbot) then
1919 C what fraction I am in
1921 & ((zj-bordlipbot)/lipbufthick)
1922 C lipbufthick is thickenes of lipid buffore
1923 sslipj=sscalelip(fracinbuf)
1924 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1925 elseif (zj.gt.bufliptop) then
1926 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1927 sslipj=sscalelip(fracinbuf)
1928 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1937 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1938 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1939 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1940 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1941 C write(iout,*) "tu,", i,j,aa_lip(itypi,itypj),bb_lip(itypi,itypj)
1942 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1943 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1944 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1945 C print *,sslipi,sslipj,bordlipbot,zi,zj
1946 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1954 xj=xj_safe+xshift*boxxsize
1955 yj=yj_safe+yshift*boxysize
1956 zj=zj_safe+zshift*boxzsize
1957 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1958 if(dist_temp.lt.dist_init) then
1968 if (subchap.eq.1) then
1977 dxj=dc_norm(1,nres+j)
1978 dyj=dc_norm(2,nres+j)
1979 dzj=dc_norm(3,nres+j)
1983 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1984 c write (iout,*) "j",j," dc_norm",
1985 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1986 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1988 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1989 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1991 c write (iout,'(a7,4f8.3)')
1992 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1993 if (sss.gt.0.0d0) then
1994 C Calculate angle-dependent terms of energy and contributions to their
1998 sig=sig0ij*dsqrt(sigsq)
1999 rij_shift=1.0D0/rij-sig+sig0ij
2000 c for diagnostics; uncomment
2001 c rij_shift=1.2*sig0ij
2002 C I hate to put IF's in the loops, but here don't have another choice!!!!
2003 if (rij_shift.le.0.0D0) then
2005 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2006 cd & restyp(itypi),i,restyp(itypj),j,
2007 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
2011 c---------------------------------------------------------------
2012 rij_shift=1.0D0/rij_shift
2013 fac=rij_shift**expon
2014 C here to start with
2019 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2020 eps2der=evdwij*eps3rt
2021 eps3der=evdwij*eps2rt
2022 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
2023 C &((sslipi+sslipj)/2.0d0+
2024 C &(2.0d0-sslipi-sslipj)/2.0d0)
2025 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
2026 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
2027 evdwij=evdwij*eps2rt*eps3rt
2028 evdw=evdw+evdwij*sss
2030 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2032 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2033 & restyp(itypi),i,restyp(itypj),j,
2034 & epsi,sigm,chi1,chi2,chip1,chip2,
2035 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
2036 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2040 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2043 C Calculate gradient components.
2044 e1=e1*eps1*eps2rt**2*eps3rt**2
2045 fac=-expon*(e1+evdwij)*rij_shift
2048 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
2049 c & evdwij,fac,sigma(itypi,itypj),expon
2050 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2052 C Calculate the radial part of the gradient
2053 gg_lipi(3)=eps1*(eps2rt*eps2rt)
2054 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
2055 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
2056 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
2057 gg_lipj(3)=ssgradlipj*gg_lipi(3)
2058 gg_lipi(3)=gg_lipi(3)*ssgradlipi
2064 C Calculate angular part of the gradient.
2074 c write (iout,*) "Number of loop steps in EGB:",ind
2075 cccc energy_dec=.false.
2078 C-----------------------------------------------------------------------------
2079 subroutine egbv(evdw)
2081 C This subroutine calculates the interaction energy of nonbonded side chains
2082 C assuming the Gay-Berne-Vorobjev potential of interaction.
2084 implicit real*8 (a-h,o-z)
2085 include 'DIMENSIONS'
2086 include 'COMMON.GEO'
2087 include 'COMMON.VAR'
2088 include 'COMMON.LOCAL'
2089 include 'COMMON.CHAIN'
2090 include 'COMMON.DERIV'
2091 include 'COMMON.NAMES'
2092 include 'COMMON.INTERACT'
2093 include 'COMMON.IOUNITS'
2094 include 'COMMON.CALC'
2095 common /srutu/ icall
2098 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
2101 c if (icall.eq.0) lprn=.true.
2103 do i=iatsc_s,iatsc_e
2104 itypi=iabs(itype(i))
2105 if (itypi.eq.ntyp1) cycle
2106 itypi1=iabs(itype(i+1))
2111 if (xi.lt.0) xi=xi+boxxsize
2113 if (yi.lt.0) yi=yi+boxysize
2115 if (zi.lt.0) zi=zi+boxzsize
2116 C define scaling factor for lipids
2118 C if (positi.le.0) positi=positi+boxzsize
2120 C first for peptide groups
2121 c for each residue check if it is in lipid or lipid water border area
2122 if ((zi.gt.bordlipbot)
2123 &.and.(zi.lt.bordliptop)) then
2124 C the energy transfer exist
2125 if (zi.lt.buflipbot) then
2126 C what fraction I am in
2128 & ((zi-bordlipbot)/lipbufthick)
2129 C lipbufthick is thickenes of lipid buffore
2130 sslipi=sscalelip(fracinbuf)
2131 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
2132 elseif (zi.gt.bufliptop) then
2133 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
2134 sslipi=sscalelip(fracinbuf)
2135 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
2145 dxi=dc_norm(1,nres+i)
2146 dyi=dc_norm(2,nres+i)
2147 dzi=dc_norm(3,nres+i)
2148 c dsci_inv=dsc_inv(itypi)
2149 dsci_inv=vbld_inv(i+nres)
2151 C Calculate SC interaction energy.
2153 do iint=1,nint_gr(i)
2154 do j=istart(i,iint),iend(i,iint)
2156 itypj=iabs(itype(j))
2157 if (itypj.eq.ntyp1) cycle
2158 c dscj_inv=dsc_inv(itypj)
2159 dscj_inv=vbld_inv(j+nres)
2160 sig0ij=sigma(itypi,itypj)
2161 r0ij=r0(itypi,itypj)
2162 chi1=chi(itypi,itypj)
2163 chi2=chi(itypj,itypi)
2170 alf12=0.5D0*(alf1+alf2)
2171 C For diagnostics only!!!
2185 if (xj.lt.0) xj=xj+boxxsize
2187 if (yj.lt.0) yj=yj+boxysize
2189 if (zj.lt.0) zj=zj+boxzsize
2190 if ((zj.gt.bordlipbot)
2191 &.and.(zj.lt.bordliptop)) then
2192 C the energy transfer exist
2193 if (zj.lt.buflipbot) then
2194 C what fraction I am in
2196 & ((zj-bordlipbot)/lipbufthick)
2197 C lipbufthick is thickenes of lipid buffore
2198 sslipj=sscalelip(fracinbuf)
2199 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
2200 elseif (zj.gt.bufliptop) then
2201 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
2202 sslipj=sscalelip(fracinbuf)
2203 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
2212 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
2213 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2214 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
2215 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2216 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
2217 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
2218 C write(iout,*) "tu,", i,j,aa,bb,aa_lip(itypi,itypj),sslipi,sslipj
2219 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2227 xj=xj_safe+xshift*boxxsize
2228 yj=yj_safe+yshift*boxysize
2229 zj=zj_safe+zshift*boxzsize
2230 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2231 if(dist_temp.lt.dist_init) then
2241 if (subchap.eq.1) then
2250 dxj=dc_norm(1,nres+j)
2251 dyj=dc_norm(2,nres+j)
2252 dzj=dc_norm(3,nres+j)
2253 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2255 C Calculate angle-dependent terms of energy and contributions to their
2259 sig=sig0ij*dsqrt(sigsq)
2260 rij_shift=1.0D0/rij-sig+r0ij
2261 C I hate to put IF's in the loops, but here don't have another choice!!!!
2262 if (rij_shift.le.0.0D0) then
2267 c---------------------------------------------------------------
2268 rij_shift=1.0D0/rij_shift
2269 fac=rij_shift**expon
2272 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2273 eps2der=evdwij*eps3rt
2274 eps3der=evdwij*eps2rt
2275 fac_augm=rrij**expon
2276 e_augm=augm(itypi,itypj)*fac_augm
2277 evdwij=evdwij*eps2rt*eps3rt
2278 evdw=evdw+evdwij+e_augm
2280 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2282 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2283 & restyp(itypi),i,restyp(itypj),j,
2284 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2285 & chi1,chi2,chip1,chip2,
2286 & eps1,eps2rt**2,eps3rt**2,
2287 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2290 C Calculate gradient components.
2291 e1=e1*eps1*eps2rt**2*eps3rt**2
2292 fac=-expon*(e1+evdwij)*rij_shift
2294 fac=rij*fac-2*expon*rrij*e_augm
2295 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2296 C Calculate the radial part of the gradient
2300 C Calculate angular part of the gradient.
2306 C-----------------------------------------------------------------------------
2307 subroutine sc_angular
2308 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2309 C om12. Called by ebp, egb, and egbv.
2311 include 'COMMON.CALC'
2312 include 'COMMON.IOUNITS'
2316 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2317 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2318 om12=dxi*dxj+dyi*dyj+dzi*dzj
2320 C Calculate eps1(om12) and its derivative in om12
2321 faceps1=1.0D0-om12*chiom12
2322 faceps1_inv=1.0D0/faceps1
2323 eps1=dsqrt(faceps1_inv)
2324 C Following variable is eps1*deps1/dom12
2325 eps1_om12=faceps1_inv*chiom12
2330 c write (iout,*) "om12",om12," eps1",eps1
2331 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2336 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2337 sigsq=1.0D0-facsig*faceps1_inv
2338 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2339 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2340 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2346 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2347 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2349 C Calculate eps2 and its derivatives in om1, om2, and om12.
2352 chipom12=chip12*om12
2353 facp=1.0D0-om12*chipom12
2355 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2356 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2357 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2358 C Following variable is the square root of eps2
2359 eps2rt=1.0D0-facp1*facp_inv
2360 C Following three variables are the derivatives of the square root of eps
2361 C in om1, om2, and om12.
2362 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2363 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2364 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2365 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2366 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2367 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2368 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2369 c & " eps2rt_om12",eps2rt_om12
2370 C Calculate whole angle-dependent part of epsilon and contributions
2371 C to its derivatives
2374 C----------------------------------------------------------------------------
2376 implicit real*8 (a-h,o-z)
2377 include 'DIMENSIONS'
2378 include 'COMMON.CHAIN'
2379 include 'COMMON.DERIV'
2380 include 'COMMON.CALC'
2381 include 'COMMON.IOUNITS'
2382 double precision dcosom1(3),dcosom2(3)
2383 cc print *,'sss=',sss
2384 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2385 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2386 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2387 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2391 c eom12=evdwij*eps1_om12
2393 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2394 c & " sigder",sigder
2395 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2396 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2398 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2399 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2402 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2404 c write (iout,*) "gg",(gg(k),k=1,3)
2406 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2407 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2408 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2409 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2410 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2411 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2412 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2413 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2414 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2415 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2418 C Calculate the components of the gradient in DC and X
2422 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2426 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2427 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2431 C-----------------------------------------------------------------------
2432 subroutine e_softsphere(evdw)
2434 C This subroutine calculates the interaction energy of nonbonded side chains
2435 C assuming the LJ potential of interaction.
2437 implicit real*8 (a-h,o-z)
2438 include 'DIMENSIONS'
2439 parameter (accur=1.0d-10)
2440 include 'COMMON.GEO'
2441 include 'COMMON.VAR'
2442 include 'COMMON.LOCAL'
2443 include 'COMMON.CHAIN'
2444 include 'COMMON.DERIV'
2445 include 'COMMON.INTERACT'
2446 include 'COMMON.TORSION'
2447 include 'COMMON.SBRIDGE'
2448 include 'COMMON.NAMES'
2449 include 'COMMON.IOUNITS'
2450 include 'COMMON.CONTACTS'
2452 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2454 do i=iatsc_s,iatsc_e
2455 itypi=iabs(itype(i))
2456 if (itypi.eq.ntyp1) cycle
2457 itypi1=iabs(itype(i+1))
2462 C Calculate SC interaction energy.
2464 do iint=1,nint_gr(i)
2465 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2466 cd & 'iend=',iend(i,iint)
2467 do j=istart(i,iint),iend(i,iint)
2468 itypj=iabs(itype(j))
2469 if (itypj.eq.ntyp1) cycle
2473 rij=xj*xj+yj*yj+zj*zj
2474 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2475 r0ij=r0(itypi,itypj)
2477 c print *,i,j,r0ij,dsqrt(rij)
2478 if (rij.lt.r0ijsq) then
2479 evdwij=0.25d0*(rij-r0ijsq)**2
2487 C Calculate the components of the gradient in DC and X
2493 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2494 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2495 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2496 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2500 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2508 C--------------------------------------------------------------------------
2509 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2512 C Soft-sphere potential of p-p interaction
2514 implicit real*8 (a-h,o-z)
2515 include 'DIMENSIONS'
2516 include 'COMMON.CONTROL'
2517 include 'COMMON.IOUNITS'
2518 include 'COMMON.GEO'
2519 include 'COMMON.VAR'
2520 include 'COMMON.LOCAL'
2521 include 'COMMON.CHAIN'
2522 include 'COMMON.DERIV'
2523 include 'COMMON.INTERACT'
2524 include 'COMMON.CONTACTS'
2525 include 'COMMON.TORSION'
2526 include 'COMMON.VECTORS'
2527 include 'COMMON.FFIELD'
2529 C write(iout,*) 'In EELEC_soft_sphere'
2536 do i=iatel_s,iatel_e
2537 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2541 xmedi=c(1,i)+0.5d0*dxi
2542 ymedi=c(2,i)+0.5d0*dyi
2543 zmedi=c(3,i)+0.5d0*dzi
2544 xmedi=mod(xmedi,boxxsize)
2545 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2546 ymedi=mod(ymedi,boxysize)
2547 if (ymedi.lt.0) ymedi=ymedi+boxysize
2548 zmedi=mod(zmedi,boxzsize)
2549 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2551 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2552 do j=ielstart(i),ielend(i)
2553 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2557 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2558 r0ij=rpp(iteli,itelj)
2567 if (xj.lt.0) xj=xj+boxxsize
2569 if (yj.lt.0) yj=yj+boxysize
2571 if (zj.lt.0) zj=zj+boxzsize
2572 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2580 xj=xj_safe+xshift*boxxsize
2581 yj=yj_safe+yshift*boxysize
2582 zj=zj_safe+zshift*boxzsize
2583 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2584 if(dist_temp.lt.dist_init) then
2594 if (isubchap.eq.1) then
2603 rij=xj*xj+yj*yj+zj*zj
2604 sss=sscale(sqrt(rij))
2605 sssgrad=sscagrad(sqrt(rij))
2606 if (rij.lt.r0ijsq) then
2607 evdw1ij=0.25d0*(rij-r0ijsq)**2
2613 evdw1=evdw1+evdw1ij*sss
2615 C Calculate contributions to the Cartesian gradient.
2617 ggg(1)=fac*xj*sssgrad
2618 ggg(2)=fac*yj*sssgrad
2619 ggg(3)=fac*zj*sssgrad
2621 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2622 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2625 * Loop over residues i+1 thru j-1.
2629 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2634 cgrad do i=nnt,nct-1
2636 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2638 cgrad do j=i+1,nct-1
2640 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2646 c------------------------------------------------------------------------------
2647 subroutine vec_and_deriv
2648 implicit real*8 (a-h,o-z)
2649 include 'DIMENSIONS'
2653 include 'COMMON.IOUNITS'
2654 include 'COMMON.GEO'
2655 include 'COMMON.VAR'
2656 include 'COMMON.LOCAL'
2657 include 'COMMON.CHAIN'
2658 include 'COMMON.VECTORS'
2659 include 'COMMON.SETUP'
2660 include 'COMMON.TIME1'
2661 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2662 C Compute the local reference systems. For reference system (i), the
2663 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2664 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2666 do i=ivec_start,ivec_end
2670 if (i.eq.nres-1) then
2671 C Case of the last full residue
2672 C Compute the Z-axis
2673 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2674 costh=dcos(pi-theta(nres))
2675 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2679 C Compute the derivatives of uz
2681 uzder(2,1,1)=-dc_norm(3,i-1)
2682 uzder(3,1,1)= dc_norm(2,i-1)
2683 uzder(1,2,1)= dc_norm(3,i-1)
2685 uzder(3,2,1)=-dc_norm(1,i-1)
2686 uzder(1,3,1)=-dc_norm(2,i-1)
2687 uzder(2,3,1)= dc_norm(1,i-1)
2690 uzder(2,1,2)= dc_norm(3,i)
2691 uzder(3,1,2)=-dc_norm(2,i)
2692 uzder(1,2,2)=-dc_norm(3,i)
2694 uzder(3,2,2)= dc_norm(1,i)
2695 uzder(1,3,2)= dc_norm(2,i)
2696 uzder(2,3,2)=-dc_norm(1,i)
2698 C Compute the Y-axis
2701 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2703 C Compute the derivatives of uy
2706 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2707 & -dc_norm(k,i)*dc_norm(j,i-1)
2708 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2710 uyder(j,j,1)=uyder(j,j,1)-costh
2711 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2716 uygrad(l,k,j,i)=uyder(l,k,j)
2717 uzgrad(l,k,j,i)=uzder(l,k,j)
2721 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2722 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2723 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2724 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2727 C Compute the Z-axis
2728 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2729 costh=dcos(pi-theta(i+2))
2730 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2734 C Compute the derivatives of uz
2736 uzder(2,1,1)=-dc_norm(3,i+1)
2737 uzder(3,1,1)= dc_norm(2,i+1)
2738 uzder(1,2,1)= dc_norm(3,i+1)
2740 uzder(3,2,1)=-dc_norm(1,i+1)
2741 uzder(1,3,1)=-dc_norm(2,i+1)
2742 uzder(2,3,1)= dc_norm(1,i+1)
2745 uzder(2,1,2)= dc_norm(3,i)
2746 uzder(3,1,2)=-dc_norm(2,i)
2747 uzder(1,2,2)=-dc_norm(3,i)
2749 uzder(3,2,2)= dc_norm(1,i)
2750 uzder(1,3,2)= dc_norm(2,i)
2751 uzder(2,3,2)=-dc_norm(1,i)
2753 C Compute the Y-axis
2756 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2758 C Compute the derivatives of uy
2761 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2762 & -dc_norm(k,i)*dc_norm(j,i+1)
2763 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2765 uyder(j,j,1)=uyder(j,j,1)-costh
2766 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2771 uygrad(l,k,j,i)=uyder(l,k,j)
2772 uzgrad(l,k,j,i)=uzder(l,k,j)
2776 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2777 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2778 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2779 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2783 vbld_inv_temp(1)=vbld_inv(i+1)
2784 if (i.lt.nres-1) then
2785 vbld_inv_temp(2)=vbld_inv(i+2)
2787 vbld_inv_temp(2)=vbld_inv(i)
2792 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2793 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2798 #if defined(PARVEC) && defined(MPI)
2799 if (nfgtasks1.gt.1) then
2801 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2802 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2803 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2804 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2805 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2807 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2808 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2810 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2811 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2812 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2813 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2814 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2815 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2816 time_gather=time_gather+MPI_Wtime()-time00
2818 c if (fg_rank.eq.0) then
2819 c write (iout,*) "Arrays UY and UZ"
2821 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2828 C-----------------------------------------------------------------------------
2829 subroutine check_vecgrad
2830 implicit real*8 (a-h,o-z)
2831 include 'DIMENSIONS'
2832 include 'COMMON.IOUNITS'
2833 include 'COMMON.GEO'
2834 include 'COMMON.VAR'
2835 include 'COMMON.LOCAL'
2836 include 'COMMON.CHAIN'
2837 include 'COMMON.VECTORS'
2838 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2839 dimension uyt(3,maxres),uzt(3,maxres)
2840 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2841 double precision delta /1.0d-7/
2844 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2845 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2846 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2847 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2848 cd & (dc_norm(if90,i),if90=1,3)
2849 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2850 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2851 cd write(iout,'(a)')
2857 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2858 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2871 cd write (iout,*) 'i=',i
2873 erij(k)=dc_norm(k,i)
2877 dc_norm(k,i)=erij(k)
2879 dc_norm(j,i)=dc_norm(j,i)+delta
2880 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2882 c dc_norm(k,i)=dc_norm(k,i)/fac
2884 c write (iout,*) (dc_norm(k,i),k=1,3)
2885 c write (iout,*) (erij(k),k=1,3)
2888 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2889 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2890 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2891 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2893 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2894 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2895 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2898 dc_norm(k,i)=erij(k)
2901 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2902 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2903 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2904 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2905 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2906 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2907 cd write (iout,'(a)')
2912 C--------------------------------------------------------------------------
2913 subroutine set_matrices
2914 implicit real*8 (a-h,o-z)
2915 include 'DIMENSIONS'
2918 include "COMMON.SETUP"
2920 integer status(MPI_STATUS_SIZE)
2922 include 'COMMON.IOUNITS'
2923 include 'COMMON.GEO'
2924 include 'COMMON.VAR'
2925 include 'COMMON.LOCAL'
2926 include 'COMMON.CHAIN'
2927 include 'COMMON.DERIV'
2928 include 'COMMON.INTERACT'
2929 include 'COMMON.CONTACTS'
2930 include 'COMMON.TORSION'
2931 include 'COMMON.VECTORS'
2932 include 'COMMON.FFIELD'
2933 double precision auxvec(2),auxmat(2,2)
2935 C Compute the virtual-bond-torsional-angle dependent quantities needed
2936 C to calculate the el-loc multibody terms of various order.
2938 c write(iout,*) 'nphi=',nphi,nres
2940 do i=ivec_start+2,ivec_end+2
2945 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2946 iti = itype2loc(itype(i-2))
2950 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2951 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2952 iti1 = itype2loc(itype(i-1))
2957 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0d0)
2958 & +bnew1(2,1,iti)*dsin(theta(i-1))
2959 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0d0)
2960 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2961 & +bnew1(2,1,iti)*dcos(theta(i-1))
2962 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2963 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2964 c &*(cos(theta(i)/2.0)
2965 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0d0)
2966 & +bnew2(2,1,iti)*dsin(theta(i-1))
2967 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0d0)
2968 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2969 c &*(cos(theta(i)/2.0)
2970 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2971 & +bnew2(2,1,iti)*dcos(theta(i-1))
2972 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2973 c if (ggb1(1,i).eq.0.0d0) then
2974 c write(iout,*) 'i=',i,ggb1(1,i),
2975 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2976 c &bnew1(2,1,iti)*cos(theta(i)),
2977 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2979 b1(2,i-2)=bnew1(1,2,iti)
2981 b2(2,i-2)=bnew2(1,2,iti)
2983 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2984 EE(1,2,i-2)=eeold(1,2,iti)
2985 EE(2,1,i-2)=eeold(2,1,iti)
2986 EE(2,2,i-2)=eeold(2,2,iti)
2987 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2992 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2993 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2994 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2995 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2996 b1tilde(1,i-2)=b1(1,i-2)
2997 b1tilde(2,i-2)=-b1(2,i-2)
2998 b2tilde(1,i-2)=b2(1,i-2)
2999 b2tilde(2,i-2)=-b2(2,i-2)
3000 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
3001 c write(iout,*) 'b1=',b1(1,i-2)
3002 c write (iout,*) 'theta=', theta(i-1)
3005 if (i.gt. nnt+2 .and. i.lt.nct+2) then
3006 iti = itype2loc(itype(i-2))
3010 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3011 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3012 iti1 = itype2loc(itype(i-1))
3020 b1tilde(1,i-2)=b1(1,i-2)
3021 b1tilde(2,i-2)=-b1(2,i-2)
3022 b2tilde(1,i-2)=b2(1,i-2)
3023 b2tilde(2,i-2)=-b2(2,i-2)
3024 EE(1,2,i-2)=eeold(1,2,iti)
3025 EE(2,1,i-2)=eeold(2,1,iti)
3026 EE(2,2,i-2)=eeold(2,2,iti)
3027 EE(1,1,i-2)=eeold(1,1,iti)
3031 do i=ivec_start+2,ivec_end+2
3035 if (i .lt. nres+1) then
3072 if (i .gt. 3 .and. i .lt. nres+1) then
3073 obrot_der(1,i-2)=-sin1
3074 obrot_der(2,i-2)= cos1
3075 Ugder(1,1,i-2)= sin1
3076 Ugder(1,2,i-2)=-cos1
3077 Ugder(2,1,i-2)=-cos1
3078 Ugder(2,2,i-2)=-sin1
3081 obrot2_der(1,i-2)=-dwasin2
3082 obrot2_der(2,i-2)= dwacos2
3083 Ug2der(1,1,i-2)= dwasin2
3084 Ug2der(1,2,i-2)=-dwacos2
3085 Ug2der(2,1,i-2)=-dwacos2
3086 Ug2der(2,2,i-2)=-dwasin2
3088 obrot_der(1,i-2)=0.0d0
3089 obrot_der(2,i-2)=0.0d0
3090 Ugder(1,1,i-2)=0.0d0
3091 Ugder(1,2,i-2)=0.0d0
3092 Ugder(2,1,i-2)=0.0d0
3093 Ugder(2,2,i-2)=0.0d0
3094 obrot2_der(1,i-2)=0.0d0
3095 obrot2_der(2,i-2)=0.0d0
3096 Ug2der(1,1,i-2)=0.0d0
3097 Ug2der(1,2,i-2)=0.0d0
3098 Ug2der(2,1,i-2)=0.0d0
3099 Ug2der(2,2,i-2)=0.0d0
3101 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
3102 if (i.gt. nnt+2 .and. i.lt.nct+2) then
3103 iti = itype2loc(itype(i-2))
3107 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3108 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3109 iti1 = itype2loc(itype(i-1))
3113 cd write (iout,*) '*******i',i,' iti1',iti
3114 cd write (iout,*) 'b1',b1(:,iti)
3115 cd write (iout,*) 'b2',b2(:,iti)
3116 cd write (iout,*) 'Ug',Ug(:,:,i-2)
3117 c if (i .gt. iatel_s+2) then
3118 if (i .gt. nnt+2) then
3119 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
3121 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
3122 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
3124 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
3125 c & EE(1,2,iti),EE(2,2,i)
3126 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
3127 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
3128 c write(iout,*) "Macierz EUG",
3129 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
3131 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3133 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
3134 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
3135 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
3136 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
3137 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
3148 DtUg2(l,k,i-2)=0.0d0
3152 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
3153 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
3155 muder(k,i-2)=Ub2der(k,i-2)
3157 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3158 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3159 if (itype(i-1).le.ntyp) then
3160 iti1 = itype2loc(itype(i-1))
3168 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
3171 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
3172 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
3173 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
3174 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
3175 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
3176 & ((ee(l,k,i-2),l=1,2),k=1,2),eenew(1,itype2loc(iti))
3178 cd write (iout,*) 'mu1',mu1(:,i-2)
3179 cd write (iout,*) 'mu2',mu2(:,i-2)
3180 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3182 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3183 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
3184 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3185 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
3186 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3187 C Vectors and matrices dependent on a single virtual-bond dihedral.
3188 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
3189 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3190 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3191 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
3192 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
3193 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3194 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3195 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3196 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3199 C Matrices dependent on two consecutive virtual-bond dihedrals.
3200 C The order of matrices is from left to right.
3201 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3203 c do i=max0(ivec_start,2),ivec_end
3205 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3206 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3207 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3208 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3209 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3210 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3211 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3212 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3215 #if defined(MPI) && defined(PARMAT)
3217 c if (fg_rank.eq.0) then
3218 write (iout,*) "Arrays UG and UGDER before GATHER"
3220 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3221 & ((ug(l,k,i),l=1,2),k=1,2),
3222 & ((ugder(l,k,i),l=1,2),k=1,2)
3224 write (iout,*) "Arrays UG2 and UG2DER"
3226 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3227 & ((ug2(l,k,i),l=1,2),k=1,2),
3228 & ((ug2der(l,k,i),l=1,2),k=1,2)
3230 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3232 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3233 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3234 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3236 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3238 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3239 & costab(i),sintab(i),costab2(i),sintab2(i)
3241 write (iout,*) "Array MUDER"
3243 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3247 if (nfgtasks.gt.1) then
3249 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
3250 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
3251 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
3253 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
3254 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3256 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
3257 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3259 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
3260 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3262 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
3263 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3265 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
3266 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3268 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
3269 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3271 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
3272 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
3273 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3274 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
3275 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
3276 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3277 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
3278 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
3279 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3280 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
3281 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
3282 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3283 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3285 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
3286 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3288 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
3289 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3291 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
3292 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3294 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3295 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3297 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3298 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3300 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3301 & ivec_count(fg_rank1),
3302 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3304 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3305 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3307 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3308 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3310 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3311 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3313 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3314 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3316 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3317 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3319 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3320 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3322 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3323 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3325 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3326 & ivec_count(fg_rank1),
3327 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3329 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3330 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3332 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3333 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3335 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3336 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3338 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3339 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3341 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3342 & ivec_count(fg_rank1),
3343 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3345 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3346 & ivec_count(fg_rank1),
3347 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3349 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3350 & ivec_count(fg_rank1),
3351 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3352 & MPI_MAT2,FG_COMM1,IERR)
3353 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3354 & ivec_count(fg_rank1),
3355 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3356 & MPI_MAT2,FG_COMM1,IERR)
3359 c Passes matrix info through the ring
3362 if (irecv.lt.0) irecv=nfgtasks1-1
3365 if (inext.ge.nfgtasks1) inext=0
3367 c write (iout,*) "isend",isend," irecv",irecv
3369 lensend=lentyp(isend)
3370 lenrecv=lentyp(irecv)
3371 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3372 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3373 c & MPI_ROTAT1(lensend),inext,2200+isend,
3374 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3375 c & iprev,2200+irecv,FG_COMM,status,IERR)
3376 c write (iout,*) "Gather ROTAT1"
3378 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3379 c & MPI_ROTAT2(lensend),inext,3300+isend,
3380 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3381 c & iprev,3300+irecv,FG_COMM,status,IERR)
3382 c write (iout,*) "Gather ROTAT2"
3384 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3385 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3386 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3387 & iprev,4400+irecv,FG_COMM,status,IERR)
3388 c write (iout,*) "Gather ROTAT_OLD"
3390 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3391 & MPI_PRECOMP11(lensend),inext,5500+isend,
3392 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3393 & iprev,5500+irecv,FG_COMM,status,IERR)
3394 c write (iout,*) "Gather PRECOMP11"
3396 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3397 & MPI_PRECOMP12(lensend),inext,6600+isend,
3398 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3399 & iprev,6600+irecv,FG_COMM,status,IERR)
3400 c write (iout,*) "Gather PRECOMP12"
3402 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3404 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3405 & MPI_ROTAT2(lensend),inext,7700+isend,
3406 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3407 & iprev,7700+irecv,FG_COMM,status,IERR)
3408 c write (iout,*) "Gather PRECOMP21"
3410 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3411 & MPI_PRECOMP22(lensend),inext,8800+isend,
3412 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3413 & iprev,8800+irecv,FG_COMM,status,IERR)
3414 c write (iout,*) "Gather PRECOMP22"
3416 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3417 & MPI_PRECOMP23(lensend),inext,9900+isend,
3418 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3419 & MPI_PRECOMP23(lenrecv),
3420 & iprev,9900+irecv,FG_COMM,status,IERR)
3421 c write (iout,*) "Gather PRECOMP23"
3426 if (irecv.lt.0) irecv=nfgtasks1-1
3429 time_gather=time_gather+MPI_Wtime()-time00
3432 c if (fg_rank.eq.0) then
3433 write (iout,*) "Arrays UG and UGDER"
3435 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3436 & ((ug(l,k,i),l=1,2),k=1,2),
3437 & ((ugder(l,k,i),l=1,2),k=1,2)
3439 write (iout,*) "Arrays UG2 and UG2DER"
3441 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3442 & ((ug2(l,k,i),l=1,2),k=1,2),
3443 & ((ug2der(l,k,i),l=1,2),k=1,2)
3445 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3447 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3448 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3449 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3451 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3453 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3454 & costab(i),sintab(i),costab2(i),sintab2(i)
3456 write (iout,*) "Array MUDER"
3458 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3464 cd iti = itype2loc(itype(i))
3467 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3468 cd & (EE(j,k,i),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3473 C--------------------------------------------------------------------------
3474 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3476 C This subroutine calculates the average interaction energy and its gradient
3477 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3478 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3479 C The potential depends both on the distance of peptide-group centers and on
3480 C the orientation of the CA-CA virtual bonds.
3482 implicit real*8 (a-h,o-z)
3486 include 'DIMENSIONS'
3487 include 'COMMON.CONTROL'
3488 include 'COMMON.SETUP'
3489 include 'COMMON.IOUNITS'
3490 include 'COMMON.GEO'
3491 include 'COMMON.VAR'
3492 include 'COMMON.LOCAL'
3493 include 'COMMON.CHAIN'
3494 include 'COMMON.DERIV'
3495 include 'COMMON.INTERACT'
3496 include 'COMMON.CONTACTS'
3497 include 'COMMON.TORSION'
3498 include 'COMMON.VECTORS'
3499 include 'COMMON.FFIELD'
3500 include 'COMMON.TIME1'
3501 include 'COMMON.SPLITELE'
3502 include 'COMMON.SHIELD'
3503 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3504 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3505 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3506 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3507 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3508 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3510 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3512 double precision scal_el /1.0d0/
3514 double precision scal_el /0.5d0/
3517 C 13-go grudnia roku pamietnego...
3518 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3519 & 0.0d0,1.0d0,0.0d0,
3520 & 0.0d0,0.0d0,1.0d0/
3521 cd write(iout,*) 'In EELEC'
3523 cd write(iout,*) 'Type',i
3524 cd write(iout,*) 'B1',B1(:,i)
3525 cd write(iout,*) 'B2',B2(:,i)
3526 cd write(iout,*) 'CC',CC(:,:,i)
3527 cd write(iout,*) 'DD',DD(:,:,i)
3528 cd write(iout,*) 'EE',EE(:,:,i)
3530 cd call check_vecgrad
3532 if (icheckgrad.eq.1) then
3534 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3536 dc_norm(k,i)=dc(k,i)*fac
3538 c write (iout,*) 'i',i,' fac',fac
3541 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3542 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3543 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3544 c call vec_and_deriv
3550 time_mat=time_mat+MPI_Wtime()-time01
3554 cd write (iout,*) 'i=',i
3556 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3559 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3560 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3573 cd print '(a)','Enter EELEC'
3574 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3576 gel_loc_loc(i)=0.0d0
3581 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3583 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3585 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3586 do i=iturn3_start,iturn3_end
3588 C write(iout,*) "tu jest i",i
3589 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3590 C changes suggested by Ana to avoid out of bounds
3591 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
3592 c & .or.((i+4).gt.nres)
3593 c & .or.((i-1).le.0)
3594 C end of changes by Ana
3595 & .or. itype(i+2).eq.ntyp1
3596 & .or. itype(i+3).eq.ntyp1) cycle
3597 C Adam: Instructions below will switch off existing interactions
3599 c if(itype(i-1).eq.ntyp1)cycle
3601 c if(i.LT.nres-3)then
3602 c if (itype(i+4).eq.ntyp1) cycle
3607 dx_normi=dc_norm(1,i)
3608 dy_normi=dc_norm(2,i)
3609 dz_normi=dc_norm(3,i)
3610 xmedi=c(1,i)+0.5d0*dxi
3611 ymedi=c(2,i)+0.5d0*dyi
3612 zmedi=c(3,i)+0.5d0*dzi
3613 xmedi=mod(xmedi,boxxsize)
3614 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3615 ymedi=mod(ymedi,boxysize)
3616 if (ymedi.lt.0) ymedi=ymedi+boxysize
3617 zmedi=mod(zmedi,boxzsize)
3618 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3619 zmedi2=mod(zmedi,boxzsize)
3620 if (zmedi2.lt.0) zmedi2=zmedi2+boxzsize
3621 if ((zmedi2.gt.bordlipbot)
3622 &.and.(zmedi2.lt.bordliptop)) then
3623 C the energy transfer exist
3624 if (zmedi2.lt.buflipbot) then
3625 C what fraction I am in
3627 & ((zmedi2-bordlipbot)/lipbufthick)
3628 C lipbufthick is thickenes of lipid buffore
3629 sslipi=sscalelip(fracinbuf)
3630 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3631 elseif (zmedi2.gt.bufliptop) then
3632 fracinbuf=1.0d0-((bordliptop-zmedi2)/lipbufthick)
3633 sslipi=sscalelip(fracinbuf)
3634 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3644 call eelecij(i,i+2,ees,evdw1,eel_loc)
3645 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3646 num_cont_hb(i)=num_conti
3648 do i=iturn4_start,iturn4_end
3650 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3651 C changes suggested by Ana to avoid out of bounds
3652 c & .or.((i+5).gt.nres)
3653 c & .or.((i-1).le.0)
3654 C end of changes suggested by Ana
3655 & .or. itype(i+3).eq.ntyp1
3656 & .or. itype(i+4).eq.ntyp1
3657 c & .or. itype(i+5).eq.ntyp1
3658 c & .or. itype(i).eq.ntyp1
3659 c & .or. itype(i-1).eq.ntyp1
3664 dx_normi=dc_norm(1,i)
3665 dy_normi=dc_norm(2,i)
3666 dz_normi=dc_norm(3,i)
3667 xmedi=c(1,i)+0.5d0*dxi
3668 ymedi=c(2,i)+0.5d0*dyi
3669 zmedi=c(3,i)+0.5d0*dzi
3670 C Return atom into box, boxxsize is size of box in x dimension
3672 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3673 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3674 C Condition for being inside the proper box
3675 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3676 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3680 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3681 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3682 C Condition for being inside the proper box
3683 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3684 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3688 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3689 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3690 C Condition for being inside the proper box
3691 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3692 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3695 xmedi=mod(xmedi,boxxsize)
3696 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3697 ymedi=mod(ymedi,boxysize)
3698 if (ymedi.lt.0) ymedi=ymedi+boxysize
3699 zmedi=mod(zmedi,boxzsize)
3700 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3701 zmedi2=mod(zmedi,boxzsize)
3702 if (zmedi2.lt.0) zmedi2=zmedi2+boxzsize
3703 if ((zmedi2.gt.bordlipbot)
3704 &.and.(zmedi2.lt.bordliptop)) then
3705 C the energy transfer exist
3706 if (zmedi2.lt.buflipbot) then
3707 C what fraction I am in
3709 & ((zmedi2-bordlipbot)/lipbufthick)
3710 C lipbufthick is thickenes of lipid buffore
3711 sslipi=sscalelip(fracinbuf)
3712 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3713 elseif (zmedi2.gt.bufliptop) then
3714 fracinbuf=1.0d0-((bordliptop-zmedi2)/lipbufthick)
3715 sslipi=sscalelip(fracinbuf)
3716 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3725 num_conti=num_cont_hb(i)
3726 c write(iout,*) "JESTEM W PETLI"
3727 call eelecij(i,i+3,ees,evdw1,eel_loc)
3728 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3729 & call eturn4(i,eello_turn4)
3730 num_cont_hb(i)=num_conti
3732 C Loop over all neighbouring boxes
3737 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3740 do i=iatel_s,iatel_e
3743 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3744 C changes suggested by Ana to avoid out of bounds
3745 c & .or.((i+2).gt.nres)
3746 c & .or.((i-1).le.0)
3747 C end of changes by Ana
3748 c & .or. itype(i+2).eq.ntyp1
3749 c & .or. itype(i-1).eq.ntyp1
3754 dx_normi=dc_norm(1,i)
3755 dy_normi=dc_norm(2,i)
3756 dz_normi=dc_norm(3,i)
3757 xmedi=c(1,i)+0.5d0*dxi
3758 ymedi=c(2,i)+0.5d0*dyi
3759 zmedi=c(3,i)+0.5d0*dzi
3760 xmedi=mod(xmedi,boxxsize)
3761 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3762 ymedi=mod(ymedi,boxysize)
3763 if (ymedi.lt.0) ymedi=ymedi+boxysize
3764 zmedi=mod(zmedi,boxzsize)
3765 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3766 if ((zmedi.gt.bordlipbot)
3767 &.and.(zmedi.lt.bordliptop)) then
3768 C the energy transfer exist
3769 if (zmedi.lt.buflipbot) then
3770 C what fraction I am in
3772 & ((zmedi-bordlipbot)/lipbufthick)
3773 C lipbufthick is thickenes of lipid buffore
3774 sslipi=sscalelip(fracinbuf)
3775 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3776 elseif (zmedi.gt.bufliptop) then
3777 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3778 sslipi=sscalelip(fracinbuf)
3779 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3788 C print *,sslipi,"TU?!"
3789 C xmedi=xmedi+xshift*boxxsize
3790 C ymedi=ymedi+yshift*boxysize
3791 C zmedi=zmedi+zshift*boxzsize
3793 C Return tom into box, boxxsize is size of box in x dimension
3795 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3796 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3797 C Condition for being inside the proper box
3798 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3799 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3803 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3804 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3805 C Condition for being inside the proper box
3806 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3807 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3811 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3812 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3813 cC Condition for being inside the proper box
3814 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3815 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3819 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3820 num_conti=num_cont_hb(i)
3822 do j=ielstart(i),ielend(i)
3824 C write (iout,*) i,j
3826 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3827 C changes suggested by Ana to avoid out of bounds
3828 c & .or.((j+2).gt.nres)
3829 c & .or.((j-1).le.0)
3830 C end of changes by Ana
3831 c & .or.itype(j+2).eq.ntyp1
3832 c & .or.itype(j-1).eq.ntyp1
3834 call eelecij(i,j,ees,evdw1,eel_loc)
3836 num_cont_hb(i)=num_conti
3842 c write (iout,*) "Number of loop steps in EELEC:",ind
3844 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3845 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3847 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3848 ccc eel_loc=eel_loc+eello_turn3
3849 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3852 C-------------------------------------------------------------------------------
3853 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3854 implicit real*8 (a-h,o-z)
3855 include 'DIMENSIONS'
3859 include 'COMMON.CONTROL'
3860 include 'COMMON.IOUNITS'
3861 include 'COMMON.GEO'
3862 include 'COMMON.VAR'
3863 include 'COMMON.LOCAL'
3864 include 'COMMON.CHAIN'
3865 include 'COMMON.DERIV'
3866 include 'COMMON.INTERACT'
3867 include 'COMMON.CONTACTS'
3868 include 'COMMON.TORSION'
3869 include 'COMMON.VECTORS'
3870 include 'COMMON.FFIELD'
3871 include 'COMMON.TIME1'
3872 include 'COMMON.SPLITELE'
3873 include 'COMMON.SHIELD'
3874 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3875 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3876 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3877 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3878 & gmuij2(4),gmuji2(4)
3879 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3880 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3882 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3884 double precision scal_el /1.0d0/
3886 double precision scal_el /0.5d0/
3889 C 13-go grudnia roku pamietnego...
3890 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3891 & 0.0d0,1.0d0,0.0d0,
3892 & 0.0d0,0.0d0,1.0d0/
3893 integer xshift,yshift,zshift
3894 c time00=MPI_Wtime()
3895 cd write (iout,*) "eelecij",i,j
3899 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3900 aaa=app(iteli,itelj)
3901 bbb=bpp(iteli,itelj)
3902 ael6i=ael6(iteli,itelj)
3903 ael3i=ael3(iteli,itelj)
3907 dx_normj=dc_norm(1,j)
3908 dy_normj=dc_norm(2,j)
3909 dz_normj=dc_norm(3,j)
3910 C xj=c(1,j)+0.5D0*dxj-xmedi
3911 C yj=c(2,j)+0.5D0*dyj-ymedi
3912 C zj=c(3,j)+0.5D0*dzj-zmedi
3917 if (xj.lt.0) xj=xj+boxxsize
3919 if (yj.lt.0) yj=yj+boxysize
3921 if (zj.lt.0) zj=zj+boxzsize
3922 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3923 if ((zj.gt.bordlipbot)
3924 &.and.(zj.lt.bordliptop)) then
3925 C the energy transfer exist
3926 if (zj.lt.buflipbot) then
3927 C what fraction I am in
3929 & ((zj-bordlipbot)/lipbufthick)
3930 C lipbufthick is thickenes of lipid buffore
3931 sslipj=sscalelip(fracinbuf)
3932 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3933 elseif (zj.gt.bufliptop) then
3934 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3935 sslipj=sscalelip(fracinbuf)
3936 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3945 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3953 xj=xj_safe+xshift*boxxsize
3954 yj=yj_safe+yshift*boxysize
3955 zj=zj_safe+zshift*boxzsize
3956 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3957 if(dist_temp.lt.dist_init) then
3967 if (isubchap.eq.1) then
3976 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3978 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3979 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3980 C Condition for being inside the proper box
3981 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3982 c & (xj.lt.((-0.5d0)*boxxsize))) then
3986 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3987 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3988 C Condition for being inside the proper box
3989 c if ((yj.gt.((0.5d0)*boxysize)).or.
3990 c & (yj.lt.((-0.5d0)*boxysize))) then
3994 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3995 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3996 C Condition for being inside the proper box
3997 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3998 c & (zj.lt.((-0.5d0)*boxzsize))) then
4001 C endif !endPBC condintion
4005 rij=xj*xj+yj*yj+zj*zj
4007 sss=sscale(sqrt(rij))
4008 sssgrad=sscagrad(sqrt(rij))
4009 c if (sss.gt.0.0d0) then
4015 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
4016 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
4017 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
4018 fac=cosa-3.0D0*cosb*cosg
4020 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
4021 if (j.eq.i+2) ev1=scal_el*ev1
4026 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
4030 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
4031 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
4032 if (shield_mode.gt.0) then
4035 el1=el1*fac_shield(i)**2*fac_shield(j)**2
4036 el2=el2*fac_shield(i)**2*fac_shield(j)**2
4039 C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
4040 C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4046 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4047 C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
4049 evdw1=evdw1+evdwij*sss
4050 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4051 C print *,sslipi,sslipj,lipscale**2,
4052 C & (sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
4053 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
4054 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
4055 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
4056 cd & xmedi,ymedi,zmedi,xj,yj,zj
4058 if (energy_dec) then
4059 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
4061 &,iteli,itelj,aaa,evdw1
4063 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
4064 &fac_shield(i),fac_shield(j)
4068 C Calculate contributions to the Cartesian gradient.
4071 facvdw=-6*rrmij*(ev1+evdwij)*sss
4072 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4073 facel=-3*rrmij*(el1+eesij)
4074 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4081 * Radial derivatives. First process both termini of the fragment (i,j)
4086 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4087 & (shield_mode.gt.0)) then
4089 do ilist=1,ishield_list(i)
4090 iresshield=shield_list(ilist,i)
4092 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
4094 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
4096 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
4097 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
4098 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
4099 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
4100 C if (iresshield.gt.i) then
4101 C do ishi=i+1,iresshield-1
4102 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
4103 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
4107 C do ishi=iresshield,i
4108 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
4109 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
4115 do ilist=1,ishield_list(j)
4116 iresshield=shield_list(ilist,j)
4118 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
4120 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
4122 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
4123 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
4125 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4126 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
4127 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4128 C if (iresshield.gt.j) then
4129 C do ishi=j+1,iresshield-1
4130 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
4131 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4135 C do ishi=iresshield,j
4136 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
4137 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4144 gshieldc(k,i)=gshieldc(k,i)+
4145 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
4146 gshieldc(k,j)=gshieldc(k,j)+
4147 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
4148 gshieldc(k,i-1)=gshieldc(k,i-1)+
4149 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
4150 gshieldc(k,j-1)=gshieldc(k,j-1)+
4151 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
4156 c ghalf=0.5D0*ggg(k)
4157 c gelc(k,i)=gelc(k,i)+ghalf
4158 c gelc(k,j)=gelc(k,j)+ghalf
4160 c 9/28/08 AL Gradient compotents will be summed only at the end
4161 C print *,"before", gelc_long(1,i), gelc_long(1,j)
4163 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4164 C & +grad_shield(k,j)*eesij/fac_shield(j)
4165 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4166 C & +grad_shield(k,i)*eesij/fac_shield(i)
4167 C gelc_long(k,i-1)=gelc_long(k,i-1)
4168 C & +grad_shield(k,i)*eesij/fac_shield(i)
4169 C gelc_long(k,j-1)=gelc_long(k,j-1)
4170 C & +grad_shield(k,j)*eesij/fac_shield(j)
4172 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
4173 C Lipidic part for lipscale
4174 gelc_long(3,j)=gelc_long(3,j)+
4175 & ssgradlipj*eesij/2.0d0*lipscale**2
4177 gelc_long(3,i)=gelc_long(3,i)+
4178 & ssgradlipi*eesij/2.0d0*lipscale**2
4181 * Loop over residues i+1 thru j-1.
4185 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4188 if (sss.gt.0.0) then
4189 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
4190 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4192 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
4193 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4195 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
4196 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4203 c ghalf=0.5D0*ggg(k)
4204 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
4205 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
4207 c 9/28/08 AL Gradient compotents will be summed only at the end
4209 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4210 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4212 C Lipidic part for scaling weight
4213 gvdwpp(3,j)=gvdwpp(3,j)+
4214 & sss*ssgradlipj*evdwij/2.0d0*lipscale**2
4215 gvdwpp(3,i)=gvdwpp(3,i)+
4216 & sss*ssgradlipi*evdwij/2.0d0*lipscale**2
4219 * Loop over residues i+1 thru j-1.
4223 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
4228 facvdw=(ev1+evdwij)*sss
4229 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4232 fac=-3*rrmij*(facvdw+facvdw+facel)
4237 * Radial derivatives. First process both termini of the fragment (i,j)
4240 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
4242 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
4244 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
4246 c ghalf=0.5D0*ggg(k)
4247 c gelc(k,i)=gelc(k,i)+ghalf
4248 c gelc(k,j)=gelc(k,j)+ghalf
4250 c 9/28/08 AL Gradient compotents will be summed only at the end
4252 gelc_long(k,j)=gelc(k,j)+ggg(k)
4253 gelc_long(k,i)=gelc(k,i)-ggg(k)
4256 * Loop over residues i+1 thru j-1.
4260 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4263 c 9/28/08 AL Gradient compotents will be summed only at the end
4264 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
4265 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4267 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
4268 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4270 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
4271 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4273 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4274 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4276 gvdwpp(3,j)=gvdwpp(3,j)+
4277 & sss*ssgradlipj*evdwij/2.0d0*lipscale**2
4278 gvdwpp(3,i)=gvdwpp(3,i)+
4279 & sss*ssgradlipi*evdwij/2.0d0*lipscale**2
4285 ecosa=2.0D0*fac3*fac1+fac4
4288 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
4289 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
4291 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4292 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4294 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
4295 cd & (dcosg(k),k=1,3)
4297 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
4298 & fac_shield(i)**2*fac_shield(j)**2
4299 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4302 c ghalf=0.5D0*ggg(k)
4303 c gelc(k,i)=gelc(k,i)+ghalf
4304 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4305 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4306 c gelc(k,j)=gelc(k,j)+ghalf
4307 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4308 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4312 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4315 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
4318 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4319 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
4320 & *fac_shield(i)**2*fac_shield(j)**2
4321 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4323 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4324 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
4325 & *fac_shield(i)**2*fac_shield(j)**2
4326 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4327 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4328 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4330 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
4334 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
4335 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
4336 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4338 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
4339 C energy of a peptide unit is assumed in the form of a second-order
4340 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
4341 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
4342 C are computed for EVERY pair of non-contiguous peptide groups.
4345 if (j.lt.nres-1) then
4357 muij(kkk)=mu(k,i)*mu(l,j)
4358 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
4360 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
4361 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
4362 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
4363 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
4364 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
4365 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4369 cd write (iout,*) 'EELEC: i',i,' j',j
4370 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
4371 cd write(iout,*) 'muij',muij
4372 ury=scalar(uy(1,i),erij)
4373 urz=scalar(uz(1,i),erij)
4374 vry=scalar(uy(1,j),erij)
4375 vrz=scalar(uz(1,j),erij)
4376 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4377 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4378 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4379 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4380 fac=dsqrt(-ael6i)*r3ij
4385 cd write (iout,'(4i5,4f10.5)')
4386 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
4387 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4388 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4389 cd & uy(:,j),uz(:,j)
4390 cd write (iout,'(4f10.5)')
4391 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4392 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4393 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
4394 cd write (iout,'(9f10.5/)')
4395 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4396 C Derivatives of the elements of A in virtual-bond vectors
4397 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4399 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4400 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4401 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4402 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4403 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4404 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4405 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4406 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4407 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4408 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4409 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4410 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4412 C Compute radial contributions to the gradient
4430 C Add the contributions coming from er
4433 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4434 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4435 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4436 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4439 C Derivatives in DC(i)
4440 cgrad ghalf1=0.5d0*agg(k,1)
4441 cgrad ghalf2=0.5d0*agg(k,2)
4442 cgrad ghalf3=0.5d0*agg(k,3)
4443 cgrad ghalf4=0.5d0*agg(k,4)
4444 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
4445 & -3.0d0*uryg(k,2)*vry)!+ghalf1
4446 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
4447 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
4448 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
4449 & -3.0d0*urzg(k,2)*vry)!+ghalf3
4450 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
4451 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
4452 C Derivatives in DC(i+1)
4453 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
4454 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4455 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
4456 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4457 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
4458 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4459 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
4460 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4461 C Derivatives in DC(j)
4462 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
4463 & -3.0d0*vryg(k,2)*ury)!+ghalf1
4464 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4465 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4466 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4467 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4468 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4469 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4470 C Derivatives in DC(j+1) or DC(nres-1)
4471 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4472 & -3.0d0*vryg(k,3)*ury)
4473 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4474 & -3.0d0*vrzg(k,3)*ury)
4475 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4476 & -3.0d0*vryg(k,3)*urz)
4477 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4478 & -3.0d0*vrzg(k,3)*urz)
4479 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4481 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4494 aggi(k,l)=-aggi(k,l)
4495 aggi1(k,l)=-aggi1(k,l)
4496 aggj(k,l)=-aggj(k,l)
4497 aggj1(k,l)=-aggj1(k,l)
4500 if (j.lt.nres-1) then
4506 aggi(k,l)=-aggi(k,l)
4507 aggi1(k,l)=-aggi1(k,l)
4508 aggj(k,l)=-aggj(k,l)
4509 aggj1(k,l)=-aggj1(k,l)
4520 aggi(k,l)=-aggi(k,l)
4521 aggi1(k,l)=-aggi1(k,l)
4522 aggj(k,l)=-aggj(k,l)
4523 aggj1(k,l)=-aggj1(k,l)
4528 IF (wel_loc.gt.0.0d0) THEN
4529 C Contribution to the local-electrostatic energy coming from the i-j pair
4530 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4532 if (shield_mode.eq.0) then
4539 eel_loc_ij=eel_loc_ij
4540 & *fac_shield(i)*fac_shield(j)
4541 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4543 C Now derivative over eel_loc
4544 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4545 & (shield_mode.gt.0)) then
4548 do ilist=1,ishield_list(i)
4549 iresshield=shield_list(ilist,i)
4551 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
4554 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4556 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
4557 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4561 do ilist=1,ishield_list(j)
4562 iresshield=shield_list(ilist,j)
4564 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
4567 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4569 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
4570 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4577 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
4578 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4579 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
4580 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4581 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
4582 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4583 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
4584 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4589 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4590 c & ' eel_loc_ij',eel_loc_ij
4591 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4592 C Calculate patrial derivative for theta angle
4594 geel_loc_ij=(a22*gmuij1(1)
4598 & *fac_shield(i)*fac_shield(j)
4599 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4601 c write(iout,*) "derivative over thatai"
4602 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4604 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4605 & geel_loc_ij*wel_loc
4606 c write(iout,*) "derivative over thatai-1"
4607 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4614 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4615 & geel_loc_ij*wel_loc
4616 & *fac_shield(i)*fac_shield(j)
4617 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4620 c Derivative over j residue
4621 geel_loc_ji=a22*gmuji1(1)
4625 c write(iout,*) "derivative over thataj"
4626 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4629 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4630 & geel_loc_ji*wel_loc
4631 & *fac_shield(i)*fac_shield(j)
4632 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4639 c write(iout,*) "derivative over thataj-1"
4640 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4642 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4643 & geel_loc_ji*wel_loc
4644 & *fac_shield(i)*fac_shield(j)
4645 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4648 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4650 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2f7.3)')
4651 & 'eelloc',i,j,eel_loc_ij,a22*muij(1),a23*muij(2)
4652 c if (eel_loc_ij.ne.0)
4653 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4654 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4656 eel_loc=eel_loc+eel_loc_ij
4657 C Partial derivatives in virtual-bond dihedral angles gamma
4659 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4660 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4661 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
4662 & *fac_shield(i)*fac_shield(j)
4663 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4665 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4666 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4667 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
4668 & *fac_shield(i)*fac_shield(j)
4669 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4671 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4673 ggg(l)=(agg(l,1)*muij(1)+
4674 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
4675 & *fac_shield(i)*fac_shield(j)
4676 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4678 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4679 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4680 cgrad ghalf=0.5d0*ggg(l)
4681 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4682 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4684 gel_loc_long(3,j)=gel_loc_long(3,j)+
4685 & ssgradlipj*eel_loc_ij/2.0d0*lipscale/
4686 & ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4688 gel_loc_long(3,i)=gel_loc_long(3,i)+
4689 & ssgradlipi*eel_loc_ij/2.0d0*lipscale/
4690 & ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4694 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4697 C Remaining derivatives of eello
4699 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4700 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4701 & *fac_shield(i)*fac_shield(j)
4702 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4704 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4705 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4706 & *fac_shield(i)*fac_shield(j)
4707 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4709 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4710 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4711 & *fac_shield(i)*fac_shield(j)
4712 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4714 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4715 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4716 & *fac_shield(i)*fac_shield(j)
4717 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4721 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4722 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4723 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4724 & .and. num_conti.le.maxconts) then
4725 c write (iout,*) i,j," entered corr"
4727 C Calculate the contact function. The ith column of the array JCONT will
4728 C contain the numbers of atoms that make contacts with the atom I (of numbers
4729 C greater than I). The arrays FACONT and GACONT will contain the values of
4730 C the contact function and its derivative.
4731 c r0ij=1.02D0*rpp(iteli,itelj)
4732 c r0ij=1.11D0*rpp(iteli,itelj)
4733 r0ij=2.20D0*rpp(iteli,itelj)
4734 c r0ij=1.55D0*rpp(iteli,itelj)
4735 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4736 if (fcont.gt.0.0D0) then
4737 num_conti=num_conti+1
4738 if (num_conti.gt.maxconts) then
4739 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4740 & ' will skip next contacts for this conf.'
4742 jcont_hb(num_conti,i)=j
4743 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4744 cd & " jcont_hb",jcont_hb(num_conti,i)
4745 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4746 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4747 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4749 d_cont(num_conti,i)=rij
4750 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4751 C --- Electrostatic-interaction matrix ---
4752 a_chuj(1,1,num_conti,i)=a22
4753 a_chuj(1,2,num_conti,i)=a23
4754 a_chuj(2,1,num_conti,i)=a32
4755 a_chuj(2,2,num_conti,i)=a33
4756 C --- Gradient of rij
4758 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4765 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4766 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4767 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4768 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4769 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4774 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4775 C Calculate contact energies
4777 wij=cosa-3.0D0*cosb*cosg
4780 c fac3=dsqrt(-ael6i)/r0ij**3
4781 fac3=dsqrt(-ael6i)*r3ij
4782 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4783 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4784 if (ees0tmp.gt.0) then
4785 ees0pij=dsqrt(ees0tmp)
4789 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4790 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4791 if (ees0tmp.gt.0) then
4792 ees0mij=dsqrt(ees0tmp)
4797 if (shield_mode.eq.0) then
4801 ees0plist(num_conti,i)=j
4802 C fac_shield(i)=0.4d0
4803 C fac_shield(j)=0.6d0
4805 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4806 & *fac_shield(i)*fac_shield(j)
4807 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4808 & *fac_shield(i)*fac_shield(j)
4809 C Diagnostics. Comment out or remove after debugging!
4810 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4811 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4812 c ees0m(num_conti,i)=0.0D0
4814 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4815 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4816 C Angular derivatives of the contact function
4817 ees0pij1=fac3/ees0pij
4818 ees0mij1=fac3/ees0mij
4819 fac3p=-3.0D0*fac3*rrmij
4820 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4821 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4823 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4824 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4825 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4826 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4827 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4828 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4829 ecosap=ecosa1+ecosa2
4830 ecosbp=ecosb1+ecosb2
4831 ecosgp=ecosg1+ecosg2
4832 ecosam=ecosa1-ecosa2
4833 ecosbm=ecosb1-ecosb2
4834 ecosgm=ecosg1-ecosg2
4843 facont_hb(num_conti,i)=fcont
4844 fprimcont=fprimcont/rij
4845 cd facont_hb(num_conti,i)=1.0D0
4846 C Following line is for diagnostics.
4849 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4850 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4853 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4854 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4856 gggp(1)=gggp(1)+ees0pijp*xj
4857 gggp(2)=gggp(2)+ees0pijp*yj
4858 gggp(3)=gggp(3)+ees0pijp*zj
4859 gggm(1)=gggm(1)+ees0mijp*xj
4860 gggm(2)=gggm(2)+ees0mijp*yj
4861 gggm(3)=gggm(3)+ees0mijp*zj
4862 C Derivatives due to the contact function
4863 gacont_hbr(1,num_conti,i)=fprimcont*xj
4864 gacont_hbr(2,num_conti,i)=fprimcont*yj
4865 gacont_hbr(3,num_conti,i)=fprimcont*zj
4868 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4869 c following the change of gradient-summation algorithm.
4871 cgrad ghalfp=0.5D0*gggp(k)
4872 cgrad ghalfm=0.5D0*gggm(k)
4873 gacontp_hb1(k,num_conti,i)=!ghalfp
4874 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4875 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4876 & *fac_shield(i)*fac_shield(j)
4878 gacontp_hb2(k,num_conti,i)=!ghalfp
4879 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4880 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4881 & *fac_shield(i)*fac_shield(j)
4883 gacontp_hb3(k,num_conti,i)=gggp(k)
4884 & *fac_shield(i)*fac_shield(j)
4886 gacontm_hb1(k,num_conti,i)=!ghalfm
4887 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4888 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4889 & *fac_shield(i)*fac_shield(j)
4891 gacontm_hb2(k,num_conti,i)=!ghalfm
4892 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4893 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4894 & *fac_shield(i)*fac_shield(j)
4896 gacontm_hb3(k,num_conti,i)=gggm(k)
4897 & *fac_shield(i)*fac_shield(j)
4900 C Diagnostics. Comment out or remove after debugging!
4902 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4903 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4904 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4905 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4906 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4907 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4910 endif ! num_conti.le.maxconts
4913 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4916 ghalf=0.5d0*agg(l,k)
4917 aggi(l,k)=aggi(l,k)+ghalf
4918 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4919 aggj(l,k)=aggj(l,k)+ghalf
4922 if (j.eq.nres-1 .and. i.lt.j-2) then
4925 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4930 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4933 C-----------------------------------------------------------------------------
4934 subroutine eturn3(i,eello_turn3)
4935 C Third- and fourth-order contributions from turns
4936 implicit real*8 (a-h,o-z)
4937 include 'DIMENSIONS'
4938 include 'COMMON.IOUNITS'
4939 include 'COMMON.GEO'
4940 include 'COMMON.VAR'
4941 include 'COMMON.LOCAL'
4942 include 'COMMON.CHAIN'
4943 include 'COMMON.DERIV'
4944 include 'COMMON.INTERACT'
4945 include 'COMMON.CONTACTS'
4946 include 'COMMON.TORSION'
4947 include 'COMMON.VECTORS'
4948 include 'COMMON.FFIELD'
4949 include 'COMMON.CONTROL'
4950 include 'COMMON.SHIELD'
4952 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4953 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4954 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4955 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4956 & auxgmat2(2,2),auxgmatt2(2,2)
4957 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4958 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4959 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4960 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4963 C xj=(c(1,j)+c(1,j+1))/2.0d0
4964 C yj=(c(2,j)+c(2,j+1))/2.0d0
4965 zj=(c(3,j)+c(3,j+1))/2.0d0
4966 C xj=mod(xj,boxxsize)
4967 C if (xj.lt.0) xj=xj+boxxsize
4968 C yj=mod(yj,boxysize)
4969 C if (yj.lt.0) yj=yj+boxysize
4971 if (zj.lt.0) zj=zj+boxzsize
4972 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
4973 if ((zj.gt.bordlipbot)
4974 &.and.(zj.lt.bordliptop)) then
4975 C the energy transfer exist
4976 if (zj.lt.buflipbot) then
4977 C what fraction I am in
4979 & ((zj-bordlipbot)/lipbufthick)
4980 C lipbufthick is thickenes of lipid buffore
4981 sslipj=sscalelip(fracinbuf)
4982 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4983 elseif (zj.gt.bufliptop) then
4984 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4985 sslipj=sscalelip(fracinbuf)
4986 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4998 C write (iout,*) "eturn3",i,j,j1,j2
5003 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5005 C Third-order contributions
5012 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5013 cd call checkint_turn3(i,a_temp,eello_turn3_num)
5014 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
5015 c auxalary matices for theta gradient
5016 c auxalary matrix for i+1 and constant i+2
5017 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
5018 c auxalary matrix for i+2 and constant i+1
5019 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
5020 call transpose2(auxmat(1,1),auxmat1(1,1))
5021 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
5022 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
5023 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5024 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
5025 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
5026 if (shield_mode.eq.0) then
5034 C & write(iout,*) i,j,fac_shield(i),fac_shield(j)
5035 eello_turn3=eello_turn3+
5036 C & 1.0*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5037 &0.5d0*(pizda(1,1)+pizda(2,2))
5038 & *fac_shield(i)*fac_shield(j)
5039 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5041 &0.5d0*(pizda(1,1)+pizda(2,2))
5042 & *fac_shield(i)*fac_shield(j)
5044 C Derivatives in theta
5045 gloc(nphi+i,icg)=gloc(nphi+i,icg)
5046 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
5047 & *fac_shield(i)*fac_shield(j)
5048 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5050 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
5051 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
5052 & *fac_shield(i)*fac_shield(j)
5053 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5057 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5058 C Derivatives in shield mode
5059 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
5060 & (shield_mode.gt.0)) then
5063 do ilist=1,ishield_list(i)
5064 iresshield=shield_list(ilist,i)
5066 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
5068 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
5070 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
5071 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
5075 do ilist=1,ishield_list(j)
5076 iresshield=shield_list(ilist,j)
5078 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
5080 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
5082 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
5083 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
5090 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
5091 & grad_shield(k,i)*eello_t3/fac_shield(i)
5092 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
5093 & grad_shield(k,j)*eello_t3/fac_shield(j)
5094 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
5095 & grad_shield(k,i)*eello_t3/fac_shield(i)
5096 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
5097 & grad_shield(k,j)*eello_t3/fac_shield(j)
5101 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5102 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
5103 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
5104 cd & ' eello_turn3_num',4*eello_turn3_num
5105 C Derivatives in gamma(i)
5106 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
5107 call transpose2(auxmat2(1,1),auxmat3(1,1))
5108 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
5109 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
5110 & *fac_shield(i)*fac_shield(j)
5111 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5113 C Derivatives in gamma(i+1)
5114 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
5115 call transpose2(auxmat2(1,1),auxmat3(1,1))
5116 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
5117 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
5118 & +0.5d0*(pizda(1,1)+pizda(2,2))
5119 & *fac_shield(i)*fac_shield(j)
5120 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5122 C Cartesian derivatives
5124 c ghalf1=0.5d0*agg(l,1)
5125 c ghalf2=0.5d0*agg(l,2)
5126 c ghalf3=0.5d0*agg(l,3)
5127 c ghalf4=0.5d0*agg(l,4)
5128 a_temp(1,1)=aggi(l,1)!+ghalf1
5129 a_temp(1,2)=aggi(l,2)!+ghalf2
5130 a_temp(2,1)=aggi(l,3)!+ghalf3
5131 a_temp(2,2)=aggi(l,4)!+ghalf4
5132 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5133 gcorr3_turn(l,i)=gcorr3_turn(l,i)
5134 & +0.5d0*(pizda(1,1)+pizda(2,2))
5135 & *fac_shield(i)*fac_shield(j)
5136 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5138 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
5139 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
5140 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
5141 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
5142 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5143 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
5144 & +0.5d0*(pizda(1,1)+pizda(2,2))
5145 & *fac_shield(i)*fac_shield(j)
5146 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5147 a_temp(1,1)=aggj(l,1)!+ghalf1
5148 a_temp(1,2)=aggj(l,2)!+ghalf2
5149 a_temp(2,1)=aggj(l,3)!+ghalf3
5150 a_temp(2,2)=aggj(l,4)!+ghalf4
5151 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5152 gcorr3_turn(l,j)=gcorr3_turn(l,j)
5153 & +0.5d0*(pizda(1,1)+pizda(2,2))
5154 & *fac_shield(i)*fac_shield(j)
5155 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5157 a_temp(1,1)=aggj1(l,1)
5158 a_temp(1,2)=aggj1(l,2)
5159 a_temp(2,1)=aggj1(l,3)
5160 a_temp(2,2)=aggj1(l,4)
5161 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5162 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
5163 & +0.5d0*(pizda(1,1)+pizda(2,2))
5164 & *fac_shield(i)*fac_shield(j)
5165 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5167 gshieldc_t3(3,i)=gshieldc_t3(3,i)+
5168 & ssgradlipi*eello_t3/4.0d0*lipscale
5169 gshieldc_t3(3,j)=gshieldc_t3(3,j)+
5170 & ssgradlipj*eello_t3/4.0d0*lipscale
5171 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+
5172 & ssgradlipi*eello_t3/4.0d0*lipscale
5173 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+
5174 & ssgradlipj*eello_t3/4.0d0*lipscale
5176 C print *,ssgradlipi,ssgradlipj,eello_t3,sslipi,sslipj
5179 C-------------------------------------------------------------------------------
5180 subroutine eturn4(i,eello_turn4)
5181 C Third- and fourth-order contributions from turns
5182 implicit real*8 (a-h,o-z)
5183 include 'DIMENSIONS'
5184 include 'COMMON.IOUNITS'
5185 include 'COMMON.GEO'
5186 include 'COMMON.VAR'
5187 include 'COMMON.LOCAL'
5188 include 'COMMON.CHAIN'
5189 include 'COMMON.DERIV'
5190 include 'COMMON.INTERACT'
5191 include 'COMMON.CONTACTS'
5192 include 'COMMON.TORSION'
5193 include 'COMMON.VECTORS'
5194 include 'COMMON.FFIELD'
5195 include 'COMMON.CONTROL'
5196 include 'COMMON.SHIELD'
5198 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
5199 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
5200 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
5201 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
5202 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
5203 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
5204 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
5205 double precision agg(3,4),aggi(3,4),aggi1(3,4),
5206 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
5207 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
5208 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
5211 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5213 C Fourth-order contributions
5221 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5222 cd call checkint_turn4(i,a_temp,eello_turn4_num)
5223 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
5224 c write(iout,*)"WCHODZE W PROGRAM"
5225 zj=(c(3,j)+c(3,j+1))/2.0d0
5226 C xj=mod(xj,boxxsize)
5227 C if (xj.lt.0) xj=xj+boxxsize
5228 C yj=mod(yj,boxysize)
5229 C if (yj.lt.0) yj=yj+boxysize
5231 if (zj.lt.0) zj=zj+boxzsize
5232 C if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
5233 if ((zj.gt.bordlipbot)
5234 &.and.(zj.lt.bordliptop)) then
5235 C the energy transfer exist
5236 if (zj.lt.buflipbot) then
5237 C what fraction I am in
5239 & ((zj-bordlipbot)/lipbufthick)
5240 C lipbufthick is thickenes of lipid buffore
5241 sslipj=sscalelip(fracinbuf)
5242 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
5243 elseif (zj.gt.bufliptop) then
5244 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
5245 sslipj=sscalelip(fracinbuf)
5246 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
5260 iti1=itype2loc(itype(i+1))
5261 iti2=itype2loc(itype(i+2))
5262 iti3=itype2loc(itype(i+3))
5263 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
5264 call transpose2(EUg(1,1,i+1),e1t(1,1))
5265 call transpose2(Eug(1,1,i+2),e2t(1,1))
5266 call transpose2(Eug(1,1,i+3),e3t(1,1))
5267 C Ematrix derivative in theta
5268 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
5269 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
5270 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
5271 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5272 c eta1 in derivative theta
5273 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
5274 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5275 c auxgvec is derivative of Ub2 so i+3 theta
5276 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
5277 c auxalary matrix of E i+1
5278 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
5281 s1=scalar2(b1(1,i+2),auxvec(1))
5282 c derivative of theta i+2 with constant i+3
5283 gs23=scalar2(gtb1(1,i+2),auxvec(1))
5284 c derivative of theta i+2 with constant i+2
5285 gs32=scalar2(b1(1,i+2),auxgvec(1))
5286 c derivative of E matix in theta of i+1
5287 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
5289 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5290 c ea31 in derivative theta
5291 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
5292 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5293 c auxilary matrix auxgvec of Ub2 with constant E matirx
5294 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
5295 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
5296 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
5300 s2=scalar2(b1(1,i+1),auxvec(1))
5301 c derivative of theta i+1 with constant i+3
5302 gs13=scalar2(gtb1(1,i+1),auxvec(1))
5303 c derivative of theta i+2 with constant i+1
5304 gs21=scalar2(b1(1,i+1),auxgvec(1))
5305 c derivative of theta i+3 with constant i+1
5306 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
5307 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
5309 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5310 c two derivatives over diffetent matrices
5311 c gtae3e2 is derivative over i+3
5312 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
5313 c ae3gte2 is derivative over i+2
5314 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
5315 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5316 c three possible derivative over theta E matices
5318 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
5320 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
5322 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
5323 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5325 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
5326 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
5327 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
5328 if (shield_mode.eq.0) then
5335 eello_turn4=eello_turn4-(s1+s2+s3)
5336 & *fac_shield(i)*fac_shield(j)
5337 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5339 eello_t4=-(s1+s2+s3)
5340 & *fac_shield(i)*fac_shield(j)
5341 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
5342 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
5343 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
5344 C Now derivative over shield:
5345 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
5346 & (shield_mode.gt.0)) then
5349 do ilist=1,ishield_list(i)
5350 iresshield=shield_list(ilist,i)
5352 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
5354 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
5356 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
5357 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
5361 do ilist=1,ishield_list(j)
5362 iresshield=shield_list(ilist,j)
5364 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
5366 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
5368 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
5369 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
5376 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
5377 & grad_shield(k,i)*eello_t4/fac_shield(i)
5378 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
5379 & grad_shield(k,j)*eello_t4/fac_shield(j)
5380 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
5381 & grad_shield(k,i)*eello_t4/fac_shield(i)
5382 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
5383 & grad_shield(k,j)*eello_t4/fac_shield(j)
5392 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5393 cd & ' eello_turn4_num',8*eello_turn4_num
5395 gloc(nphi+i,icg)=gloc(nphi+i,icg)
5396 & -(gs13+gsE13+gsEE1)*wturn4
5397 & *fac_shield(i)*fac_shield(j)
5398 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5400 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
5401 & -(gs23+gs21+gsEE2)*wturn4
5402 & *fac_shield(i)*fac_shield(j)
5403 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5405 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
5406 & -(gs32+gsE31+gsEE3)*wturn4
5407 & *fac_shield(i)*fac_shield(j)
5408 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5410 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
5413 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5414 & 'eturn4',i,j,-(s1+s2+s3)
5415 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5416 c & ' eello_turn4_num',8*eello_turn4_num
5417 C Derivatives in gamma(i)
5418 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
5419 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
5420 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
5421 s1=scalar2(b1(1,i+2),auxvec(1))
5422 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
5423 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5424 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
5425 & *fac_shield(i)*fac_shield(j)
5426 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5428 C Derivatives in gamma(i+1)
5429 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
5430 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
5431 s2=scalar2(b1(1,i+1),auxvec(1))
5432 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5433 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5434 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5435 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
5436 & *fac_shield(i)*fac_shield(j)
5437 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5439 C Derivatives in gamma(i+2)
5440 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5441 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5442 s1=scalar2(b1(1,i+2),auxvec(1))
5443 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5444 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5445 s2=scalar2(b1(1,i+1),auxvec(1))
5446 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5447 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5448 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5449 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
5450 & *fac_shield(i)*fac_shield(j)
5451 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5453 C Cartesian derivatives
5454 C Derivatives of this turn contributions in DC(i+2)
5455 if (j.lt.nres-1) then
5457 a_temp(1,1)=agg(l,1)
5458 a_temp(1,2)=agg(l,2)
5459 a_temp(2,1)=agg(l,3)
5460 a_temp(2,2)=agg(l,4)
5461 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5462 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5463 s1=scalar2(b1(1,i+2),auxvec(1))
5464 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5465 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5466 s2=scalar2(b1(1,i+1),auxvec(1))
5467 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5468 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5469 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5471 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
5472 & *fac_shield(i)*fac_shield(j)
5473 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5477 C Remaining derivatives of this turn contribution
5479 a_temp(1,1)=aggi(l,1)
5480 a_temp(1,2)=aggi(l,2)
5481 a_temp(2,1)=aggi(l,3)
5482 a_temp(2,2)=aggi(l,4)
5483 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5484 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5485 s1=scalar2(b1(1,i+2),auxvec(1))
5486 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5487 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5488 s2=scalar2(b1(1,i+1),auxvec(1))
5489 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5490 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5491 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5492 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
5493 & *fac_shield(i)*fac_shield(j)
5494 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5496 a_temp(1,1)=aggi1(l,1)
5497 a_temp(1,2)=aggi1(l,2)
5498 a_temp(2,1)=aggi1(l,3)
5499 a_temp(2,2)=aggi1(l,4)
5500 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5501 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5502 s1=scalar2(b1(1,i+2),auxvec(1))
5503 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5504 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5505 s2=scalar2(b1(1,i+1),auxvec(1))
5506 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5507 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5508 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5509 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
5510 & *fac_shield(i)*fac_shield(j)
5511 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5513 a_temp(1,1)=aggj(l,1)
5514 a_temp(1,2)=aggj(l,2)
5515 a_temp(2,1)=aggj(l,3)
5516 a_temp(2,2)=aggj(l,4)
5517 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5518 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5519 s1=scalar2(b1(1,i+2),auxvec(1))
5520 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5521 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5522 s2=scalar2(b1(1,i+1),auxvec(1))
5523 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5524 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5525 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5526 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
5527 & *fac_shield(i)*fac_shield(j)
5528 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5530 a_temp(1,1)=aggj1(l,1)
5531 a_temp(1,2)=aggj1(l,2)
5532 a_temp(2,1)=aggj1(l,3)
5533 a_temp(2,2)=aggj1(l,4)
5534 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5535 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5536 s1=scalar2(b1(1,i+2),auxvec(1))
5537 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5538 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5539 s2=scalar2(b1(1,i+1),auxvec(1))
5540 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5541 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5542 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5543 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5544 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
5545 & *fac_shield(i)*fac_shield(j)
5546 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5548 gshieldc_t4(3,i)=gshieldc_t4(3,i)+
5549 & ssgradlipi*eello_t4/4.0d0*lipscale
5550 gshieldc_t4(3,j)=gshieldc_t4(3,j)+
5551 & ssgradlipj*eello_t4/4.0d0*lipscale
5552 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+
5553 & ssgradlipi*eello_t4/4.0d0*lipscale
5554 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+
5555 & ssgradlipj*eello_t4/4.0d0*lipscale
5558 C-----------------------------------------------------------------------------
5559 subroutine vecpr(u,v,w)
5560 implicit real*8(a-h,o-z)
5561 dimension u(3),v(3),w(3)
5562 w(1)=u(2)*v(3)-u(3)*v(2)
5563 w(2)=-u(1)*v(3)+u(3)*v(1)
5564 w(3)=u(1)*v(2)-u(2)*v(1)
5567 C-----------------------------------------------------------------------------
5568 subroutine unormderiv(u,ugrad,unorm,ungrad)
5569 C This subroutine computes the derivatives of a normalized vector u, given
5570 C the derivatives computed without normalization conditions, ugrad. Returns
5573 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
5574 double precision vec(3)
5575 double precision scalar
5577 c write (2,*) 'ugrad',ugrad
5580 vec(i)=scalar(ugrad(1,i),u(1))
5582 c write (2,*) 'vec',vec
5585 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5588 c write (2,*) 'ungrad',ungrad
5591 C-----------------------------------------------------------------------------
5592 subroutine escp_soft_sphere(evdw2,evdw2_14)
5594 C This subroutine calculates the excluded-volume interaction energy between
5595 C peptide-group centers and side chains and its gradient in virtual-bond and
5596 C side-chain vectors.
5598 implicit real*8 (a-h,o-z)
5599 include 'DIMENSIONS'
5600 include 'COMMON.GEO'
5601 include 'COMMON.VAR'
5602 include 'COMMON.LOCAL'
5603 include 'COMMON.CHAIN'
5604 include 'COMMON.DERIV'
5605 include 'COMMON.INTERACT'
5606 include 'COMMON.FFIELD'
5607 include 'COMMON.IOUNITS'
5608 include 'COMMON.CONTROL'
5613 cd print '(a)','Enter ESCP'
5614 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5618 do i=iatscp_s,iatscp_e
5619 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5621 xi=0.5D0*(c(1,i)+c(1,i+1))
5622 yi=0.5D0*(c(2,i)+c(2,i+1))
5623 zi=0.5D0*(c(3,i)+c(3,i+1))
5624 C Return atom into box, boxxsize is size of box in x dimension
5626 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5627 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5628 C Condition for being inside the proper box
5629 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5630 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5634 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5635 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5636 C Condition for being inside the proper box
5637 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5638 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5642 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5643 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5644 cC Condition for being inside the proper box
5645 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5646 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5650 if (xi.lt.0) xi=xi+boxxsize
5652 if (yi.lt.0) yi=yi+boxysize
5654 if (zi.lt.0) zi=zi+boxzsize
5655 C xi=xi+xshift*boxxsize
5656 C yi=yi+yshift*boxysize
5657 C zi=zi+zshift*boxzsize
5658 do iint=1,nscp_gr(i)
5660 do j=iscpstart(i,iint),iscpend(i,iint)
5661 if (itype(j).eq.ntyp1) cycle
5662 itypj=iabs(itype(j))
5663 C Uncomment following three lines for SC-p interactions
5667 C Uncomment following three lines for Ca-p interactions
5672 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5673 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5674 C Condition for being inside the proper box
5675 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5676 c & (xj.lt.((-0.5d0)*boxxsize))) then
5680 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5681 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5682 cC Condition for being inside the proper box
5683 c if ((yj.gt.((0.5d0)*boxysize)).or.
5684 c & (yj.lt.((-0.5d0)*boxysize))) then
5688 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5689 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5690 C Condition for being inside the proper box
5691 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5692 c & (zj.lt.((-0.5d0)*boxzsize))) then
5695 if (xj.lt.0) xj=xj+boxxsize
5697 if (yj.lt.0) yj=yj+boxysize
5699 if (zj.lt.0) zj=zj+boxzsize
5700 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5708 xj=xj_safe+xshift*boxxsize
5709 yj=yj_safe+yshift*boxysize
5710 zj=zj_safe+zshift*boxzsize
5711 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5712 if(dist_temp.lt.dist_init) then
5722 if (subchap.eq.1) then
5735 rij=xj*xj+yj*yj+zj*zj
5739 if (rij.lt.r0ijsq) then
5740 evdwij=0.25d0*(rij-r0ijsq)**2
5748 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5753 cgrad if (j.lt.i) then
5754 cd write (iout,*) 'j<i'
5755 C Uncomment following three lines for SC-p interactions
5757 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5760 cd write (iout,*) 'j>i'
5762 cgrad ggg(k)=-ggg(k)
5763 C Uncomment following line for SC-p interactions
5764 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5768 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5770 cgrad kstart=min0(i+1,j)
5771 cgrad kend=max0(i-1,j-1)
5772 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5773 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5774 cgrad do k=kstart,kend
5776 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5780 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5781 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5792 C-----------------------------------------------------------------------------
5793 subroutine escp(evdw2,evdw2_14)
5795 C This subroutine calculates the excluded-volume interaction energy between
5796 C peptide-group centers and side chains and its gradient in virtual-bond and
5797 C side-chain vectors.
5799 implicit real*8 (a-h,o-z)
5800 include 'DIMENSIONS'
5801 include 'COMMON.GEO'
5802 include 'COMMON.VAR'
5803 include 'COMMON.LOCAL'
5804 include 'COMMON.CHAIN'
5805 include 'COMMON.DERIV'
5806 include 'COMMON.INTERACT'
5807 include 'COMMON.FFIELD'
5808 include 'COMMON.IOUNITS'
5809 include 'COMMON.CONTROL'
5810 include 'COMMON.SPLITELE'
5814 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
5815 cd print '(a)','Enter ESCP'
5816 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5820 do i=iatscp_s,iatscp_e
5821 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5823 xi=0.5D0*(c(1,i)+c(1,i+1))
5824 yi=0.5D0*(c(2,i)+c(2,i+1))
5825 zi=0.5D0*(c(3,i)+c(3,i+1))
5827 if (xi.lt.0) xi=xi+boxxsize
5829 if (yi.lt.0) yi=yi+boxysize
5831 if (zi.lt.0) zi=zi+boxzsize
5832 c xi=xi+xshift*boxxsize
5833 c yi=yi+yshift*boxysize
5834 c zi=zi+zshift*boxzsize
5835 c print *,xi,yi,zi,'polozenie i'
5836 C Return atom into box, boxxsize is size of box in x dimension
5838 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5839 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5840 C Condition for being inside the proper box
5841 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5842 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5846 c print *,xi,boxxsize,"pierwszy"
5848 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5849 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5850 C Condition for being inside the proper box
5851 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5852 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5856 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5857 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5858 C Condition for being inside the proper box
5859 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5860 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5863 do iint=1,nscp_gr(i)
5865 do j=iscpstart(i,iint),iscpend(i,iint)
5866 itypj=iabs(itype(j))
5867 if (itypj.eq.ntyp1) cycle
5868 C Uncomment following three lines for SC-p interactions
5872 C Uncomment following three lines for Ca-p interactions
5877 if (xj.lt.0) xj=xj+boxxsize
5879 if (yj.lt.0) yj=yj+boxysize
5881 if (zj.lt.0) zj=zj+boxzsize
5883 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5884 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5885 C Condition for being inside the proper box
5886 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5887 c & (xj.lt.((-0.5d0)*boxxsize))) then
5891 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5892 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5893 cC Condition for being inside the proper box
5894 c if ((yj.gt.((0.5d0)*boxysize)).or.
5895 c & (yj.lt.((-0.5d0)*boxysize))) then
5899 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5900 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5901 C Condition for being inside the proper box
5902 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5903 c & (zj.lt.((-0.5d0)*boxzsize))) then
5906 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5907 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5915 xj=xj_safe+xshift*boxxsize
5916 yj=yj_safe+yshift*boxysize
5917 zj=zj_safe+zshift*boxzsize
5918 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5919 if(dist_temp.lt.dist_init) then
5929 if (subchap.eq.1) then
5938 c print *,xj,yj,zj,'polozenie j'
5939 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5941 sss=sscale(1.0d0/(dsqrt(rrij)))
5942 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5943 c if (sss.eq.0) print *,'czasem jest OK'
5944 if (sss.le.0.0d0) cycle
5945 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5947 e1=fac*fac*aad(itypj,iteli)
5948 e2=fac*bad(itypj,iteli)
5949 if (iabs(j-i) .le. 2) then
5952 evdw2_14=evdw2_14+(e1+e2)*sss
5955 evdw2=evdw2+evdwij*sss
5956 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5957 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5960 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5962 fac=-(evdwij+e1)*rrij*sss
5963 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5967 cgrad if (j.lt.i) then
5968 cd write (iout,*) 'j<i'
5969 C Uncomment following three lines for SC-p interactions
5971 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5974 cd write (iout,*) 'j>i'
5976 cgrad ggg(k)=-ggg(k)
5977 C Uncomment following line for SC-p interactions
5978 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5979 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5983 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5985 cgrad kstart=min0(i+1,j)
5986 cgrad kend=max0(i-1,j-1)
5987 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5988 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5989 cgrad do k=kstart,kend
5991 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5995 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5996 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5998 c endif !endif for sscale cutoff
6008 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
6009 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
6010 gradx_scp(j,i)=expon*gradx_scp(j,i)
6013 C******************************************************************************
6017 C To save time the factor EXPON has been extracted from ALL components
6018 C of GVDWC and GRADX. Remember to multiply them by this factor before further
6021 C******************************************************************************
6024 C--------------------------------------------------------------------------
6025 subroutine edis(ehpb)
6027 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
6029 implicit real*8 (a-h,o-z)
6030 include 'DIMENSIONS'
6031 include 'COMMON.SBRIDGE'
6032 include 'COMMON.CHAIN'
6033 include 'COMMON.DERIV'
6034 include 'COMMON.VAR'
6035 include 'COMMON.INTERACT'
6036 include 'COMMON.IOUNITS'
6037 include 'COMMON.CONTROL'
6043 C write (iout,*) ,"link_end",link_end,constr_dist
6044 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
6045 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
6046 if (link_end.eq.0) return
6047 do i=link_start,link_end
6048 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
6049 C CA-CA distance used in regularization of structure.
6052 C iii and jjj point to the residues for which the distance is assigned.
6053 if (ii.gt.nres) then
6060 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
6061 c & dhpb(i),dhpb1(i),forcon(i)
6062 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
6063 C distance and angle dependent SS bond potential.
6064 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
6065 C & iabs(itype(jjj)).eq.1) then
6066 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
6067 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
6068 if (.not.dyn_ss .and. i.le.nss) then
6069 C 15/02/13 CC dynamic SSbond - additional check
6070 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
6071 & iabs(itype(jjj)).eq.1) then
6072 call ssbond_ene(iii,jjj,eij)
6075 cd write (iout,*) "eij",eij
6076 cd & ' waga=',waga,' fac=',fac
6077 else if (ii.gt.nres .and. jj.gt.nres) then
6078 c Restraints from contact prediction
6080 if (constr_dist.eq.11) then
6081 ehpb=ehpb+fordepth(i)**4.0d0
6082 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
6083 fac=fordepth(i)**4.0d0
6084 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
6085 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
6086 & ehpb,fordepth(i),dd
6088 if (dhpb1(i).gt.0.0d0) then
6089 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6090 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
6091 c write (iout,*) "beta nmr",
6092 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6096 C Get the force constant corresponding to this distance.
6098 C Calculate the contribution to energy.
6099 ehpb=ehpb+waga*rdis*rdis
6100 c write (iout,*) "beta reg",dd,waga*rdis*rdis
6102 C Evaluate gradient.
6108 ggg(j)=fac*(c(j,jj)-c(j,ii))
6111 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
6112 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
6115 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
6116 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
6119 C Calculate the distance between the two points and its difference from the
6122 if (constr_dist.eq.11) then
6123 ehpb=ehpb+fordepth(i)**4.0d0
6124 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
6125 fac=fordepth(i)**4.0d0
6126 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
6127 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
6128 & ehpb,fordepth(i),dd
6130 if (dhpb1(i).gt.0.0d0) then
6131 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6132 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
6133 c write (iout,*) "alph nmr",
6134 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6137 C Get the force constant corresponding to this distance.
6139 C Calculate the contribution to energy.
6140 ehpb=ehpb+waga*rdis*rdis
6141 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
6143 C Evaluate gradient.
6149 ggg(j)=fac*(c(j,jj)-c(j,ii))
6151 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
6152 C If this is a SC-SC distance, we need to calculate the contributions to the
6153 C Cartesian gradient in the SC vectors (ghpbx).
6156 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
6157 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
6160 cgrad do j=iii,jjj-1
6162 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
6166 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
6167 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
6171 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
6174 C--------------------------------------------------------------------------
6175 subroutine ssbond_ene(i,j,eij)
6177 C Calculate the distance and angle dependent SS-bond potential energy
6178 C using a free-energy function derived based on RHF/6-31G** ab initio
6179 C calculations of diethyl disulfide.
6181 C A. Liwo and U. Kozlowska, 11/24/03
6183 implicit real*8 (a-h,o-z)
6184 include 'DIMENSIONS'
6185 include 'COMMON.SBRIDGE'
6186 include 'COMMON.CHAIN'
6187 include 'COMMON.DERIV'
6188 include 'COMMON.LOCAL'
6189 include 'COMMON.INTERACT'
6190 include 'COMMON.VAR'
6191 include 'COMMON.IOUNITS'
6192 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
6193 itypi=iabs(itype(i))
6197 dxi=dc_norm(1,nres+i)
6198 dyi=dc_norm(2,nres+i)
6199 dzi=dc_norm(3,nres+i)
6200 c dsci_inv=dsc_inv(itypi)
6201 dsci_inv=vbld_inv(nres+i)
6202 itypj=iabs(itype(j))
6203 c dscj_inv=dsc_inv(itypj)
6204 dscj_inv=vbld_inv(nres+j)
6208 dxj=dc_norm(1,nres+j)
6209 dyj=dc_norm(2,nres+j)
6210 dzj=dc_norm(3,nres+j)
6211 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
6216 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
6217 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
6218 om12=dxi*dxj+dyi*dyj+dzi*dzj
6220 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
6221 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
6227 deltat12=om2-om1+2.0d0
6229 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
6230 & +akct*deltad*deltat12
6231 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
6232 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
6233 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
6234 c & " deltat12",deltat12," eij",eij
6235 ed=2*akcm*deltad+akct*deltat12
6237 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
6238 eom1=-2*akth*deltat1-pom1-om2*pom2
6239 eom2= 2*akth*deltat2+pom1-om1*pom2
6242 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
6243 ghpbx(k,i)=ghpbx(k,i)-ggk
6244 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
6245 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
6246 ghpbx(k,j)=ghpbx(k,j)+ggk
6247 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
6248 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
6249 ghpbc(k,i)=ghpbc(k,i)-ggk
6250 ghpbc(k,j)=ghpbc(k,j)+ggk
6253 C Calculate the components of the gradient in DC and X
6257 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
6262 C--------------------------------------------------------------------------
6263 subroutine ebond(estr)
6265 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
6267 implicit real*8 (a-h,o-z)
6268 include 'DIMENSIONS'
6269 include 'COMMON.LOCAL'
6270 include 'COMMON.GEO'
6271 include 'COMMON.INTERACT'
6272 include 'COMMON.DERIV'
6273 include 'COMMON.VAR'
6274 include 'COMMON.CHAIN'
6275 include 'COMMON.IOUNITS'
6276 include 'COMMON.NAMES'
6277 include 'COMMON.FFIELD'
6278 include 'COMMON.CONTROL'
6279 include 'COMMON.SETUP'
6280 double precision u(3),ud(3)
6283 do i=ibondp_start,ibondp_end
6284 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
6285 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
6287 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
6288 c & *dc(j,i-1)/vbld(i)
6290 c if (energy_dec) write(iout,*)
6291 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
6293 C Checking if it involves dummy (NH3+ or COO-) group
6294 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
6295 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
6296 diff = vbld(i)-vbldpDUM
6297 if (energy_dec) write(iout,*) "dum_bond",i,diff
6299 C NO vbldp0 is the equlibrium lenght of spring for peptide group
6300 diff = vbld(i)-vbldp0
6302 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
6303 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
6306 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
6308 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
6312 estr=0.5d0*AKP*estr+estr1
6314 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
6316 do i=ibond_start,ibond_end
6318 if (iti.ne.10 .and. iti.ne.ntyp1) then
6321 diff=vbld(i+nres)-vbldsc0(1,iti)
6322 if (energy_dec) write (iout,*)
6323 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
6324 & AKSC(1,iti),AKSC(1,iti)*diff*diff
6325 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
6327 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
6331 diff=vbld(i+nres)-vbldsc0(j,iti)
6332 if (energy_dec) write (iout,*)
6333 & "estr sc",i,iti,vbld(i+nres),vbldsc0(j,iti),diff,
6334 & AKSC(j,iti),AKSC(j,iti)*diff*diff
6335 ud(j)=aksc(j,iti)*diff
6336 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
6350 uprod2=uprod2*u(k)*u(k)
6354 usumsqder=usumsqder+ud(j)*uprod2
6356 estr=estr+uprod/usum
6358 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
6366 C--------------------------------------------------------------------------
6367 subroutine ebend(etheta,ethetacnstr)
6369 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6370 C angles gamma and its derivatives in consecutive thetas and gammas.
6372 implicit real*8 (a-h,o-z)
6373 include 'DIMENSIONS'
6374 include 'COMMON.LOCAL'
6375 include 'COMMON.GEO'
6376 include 'COMMON.INTERACT'
6377 include 'COMMON.DERIV'
6378 include 'COMMON.VAR'
6379 include 'COMMON.CHAIN'
6380 include 'COMMON.IOUNITS'
6381 include 'COMMON.NAMES'
6382 include 'COMMON.FFIELD'
6383 include 'COMMON.CONTROL'
6384 include 'COMMON.TORCNSTR'
6385 common /calcthet/ term1,term2,termm,diffak,ratak,
6386 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6387 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6388 double precision y(2),z(2)
6390 c time11=dexp(-2*time)
6393 c write (*,'(a,i2)') 'EBEND ICG=',icg
6394 do i=ithet_start,ithet_end
6395 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6396 & .or.itype(i).eq.ntyp1) cycle
6397 C Zero the energy function and its derivative at 0 or pi.
6398 call splinthet(theta(i),0.5d0*delta,ss,ssd)
6400 ichir1=isign(1,itype(i-2))
6401 ichir2=isign(1,itype(i))
6402 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
6403 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
6404 if (itype(i-1).eq.10) then
6405 itype1=isign(10,itype(i-2))
6406 ichir11=isign(1,itype(i-2))
6407 ichir12=isign(1,itype(i-2))
6408 itype2=isign(10,itype(i))
6409 ichir21=isign(1,itype(i))
6410 ichir22=isign(1,itype(i))
6413 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
6416 if (phii.ne.phii) phii=150.0
6426 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6429 if (phii1.ne.phii1) phii1=150.0
6441 C Calculate the "mean" value of theta from the part of the distribution
6442 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
6443 C In following comments this theta will be referred to as t_c.
6444 thet_pred_mean=0.0d0
6446 athetk=athet(k,it,ichir1,ichir2)
6447 bthetk=bthet(k,it,ichir1,ichir2)
6449 athetk=athet(k,itype1,ichir11,ichir12)
6450 bthetk=bthet(k,itype2,ichir21,ichir22)
6452 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
6453 c write(iout,*) 'chuj tu', y(k),z(k)
6455 dthett=thet_pred_mean*ssd
6456 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
6457 C Derivatives of the "mean" values in gamma1 and gamma2.
6458 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
6459 &+athet(2,it,ichir1,ichir2)*y(1))*ss
6460 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
6461 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
6463 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
6464 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
6465 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
6466 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
6468 if (theta(i).gt.pi-delta) then
6469 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
6471 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
6472 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6473 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
6475 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
6477 else if (theta(i).lt.delta) then
6478 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
6479 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6480 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
6482 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
6483 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
6486 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
6489 etheta=etheta+ethetai
6490 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
6491 & 'ebend',i,ethetai,theta(i),itype(i)
6492 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
6493 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
6494 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
6497 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6498 do i=ithetaconstr_start,ithetaconstr_end
6499 itheta=itheta_constr(i)
6500 thetiii=theta(itheta)
6501 difi=pinorm(thetiii-theta_constr0(i))
6502 if (difi.gt.theta_drange(i)) then
6503 difi=difi-theta_drange(i)
6504 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6505 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6506 & +for_thet_constr(i)*difi**3
6507 else if (difi.lt.-drange(i)) then
6509 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6510 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6511 & +for_thet_constr(i)*difi**3
6515 if (energy_dec) then
6516 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6517 & i,itheta,rad2deg*thetiii,
6518 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6519 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6520 & gloc(itheta+nphi-2,icg)
6524 C Ufff.... We've done all this!!!
6527 C---------------------------------------------------------------------------
6528 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
6530 implicit real*8 (a-h,o-z)
6531 include 'DIMENSIONS'
6532 include 'COMMON.LOCAL'
6533 include 'COMMON.IOUNITS'
6534 common /calcthet/ term1,term2,termm,diffak,ratak,
6535 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6536 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6537 C Calculate the contributions to both Gaussian lobes.
6538 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6539 C The "polynomial part" of the "standard deviation" of this part of
6540 C the distributioni.
6541 ccc write (iout,*) thetai,thet_pred_mean
6544 sig=sig*thet_pred_mean+polthet(j,it)
6546 C Derivative of the "interior part" of the "standard deviation of the"
6547 C gamma-dependent Gaussian lobe in t_c.
6548 sigtc=3*polthet(3,it)
6550 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6553 C Set the parameters of both Gaussian lobes of the distribution.
6554 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6555 fac=sig*sig+sigc0(it)
6558 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6559 sigsqtc=-4.0D0*sigcsq*sigtc
6560 c print *,i,sig,sigtc,sigsqtc
6561 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
6562 sigtc=-sigtc/(fac*fac)
6563 C Following variable is sigma(t_c)**(-2)
6564 sigcsq=sigcsq*sigcsq
6566 sig0inv=1.0D0/sig0i**2
6567 delthec=thetai-thet_pred_mean
6568 delthe0=thetai-theta0i
6569 term1=-0.5D0*sigcsq*delthec*delthec
6570 term2=-0.5D0*sig0inv*delthe0*delthe0
6571 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
6572 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6573 C NaNs in taking the logarithm. We extract the largest exponent which is added
6574 C to the energy (this being the log of the distribution) at the end of energy
6575 C term evaluation for this virtual-bond angle.
6576 if (term1.gt.term2) then
6578 term2=dexp(term2-termm)
6582 term1=dexp(term1-termm)
6585 C The ratio between the gamma-independent and gamma-dependent lobes of
6586 C the distribution is a Gaussian function of thet_pred_mean too.
6587 diffak=gthet(2,it)-thet_pred_mean
6588 ratak=diffak/gthet(3,it)**2
6589 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6590 C Let's differentiate it in thet_pred_mean NOW.
6592 C Now put together the distribution terms to make complete distribution.
6593 termexp=term1+ak*term2
6594 termpre=sigc+ak*sig0i
6595 C Contribution of the bending energy from this theta is just the -log of
6596 C the sum of the contributions from the two lobes and the pre-exponential
6597 C factor. Simple enough, isn't it?
6598 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6599 C write (iout,*) 'termexp',termexp,termm,termpre,i
6600 C NOW the derivatives!!!
6601 C 6/6/97 Take into account the deformation.
6602 E_theta=(delthec*sigcsq*term1
6603 & +ak*delthe0*sig0inv*term2)/termexp
6604 E_tc=((sigtc+aktc*sig0i)/termpre
6605 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
6606 & aktc*term2)/termexp)
6609 c-----------------------------------------------------------------------------
6610 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
6611 implicit real*8 (a-h,o-z)
6612 include 'DIMENSIONS'
6613 include 'COMMON.LOCAL'
6614 include 'COMMON.IOUNITS'
6615 common /calcthet/ term1,term2,termm,diffak,ratak,
6616 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6617 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6618 delthec=thetai-thet_pred_mean
6619 delthe0=thetai-theta0i
6620 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
6621 t3 = thetai-thet_pred_mean
6625 t14 = t12+t6*sigsqtc
6627 t21 = thetai-theta0i
6633 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
6634 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
6635 & *(-t12*t9-ak*sig0inv*t27)
6639 C--------------------------------------------------------------------------
6640 subroutine ebend(etheta,ethetacnstr)
6642 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6643 C angles gamma and its derivatives in consecutive thetas and gammas.
6644 C ab initio-derived potentials from
6645 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6647 implicit real*8 (a-h,o-z)
6648 include 'DIMENSIONS'
6649 include 'COMMON.LOCAL'
6650 include 'COMMON.GEO'
6651 include 'COMMON.INTERACT'
6652 include 'COMMON.DERIV'
6653 include 'COMMON.VAR'
6654 include 'COMMON.CHAIN'
6655 include 'COMMON.IOUNITS'
6656 include 'COMMON.NAMES'
6657 include 'COMMON.FFIELD'
6658 include 'COMMON.CONTROL'
6659 include 'COMMON.TORCNSTR'
6660 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
6661 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
6662 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
6663 & sinph1ph2(maxdouble,maxdouble)
6664 logical lprn /.false./, lprn1 /.false./
6666 do i=ithet_start,ithet_end
6667 c print *,i,itype(i-1),itype(i),itype(i-2)
6668 C if (itype(i-1).eq.ntyp1) cycle
6669 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6670 & .or.itype(i).eq.ntyp1) cycle
6671 C print *,i,theta(i)
6672 if (iabs(itype(i+1)).eq.20) iblock=2
6673 if (iabs(itype(i+1)).ne.20) iblock=1
6677 theti2=0.5d0*theta(i)
6678 ityp2=ithetyp((itype(i-1)))
6680 coskt(k)=dcos(k*theti2)
6681 sinkt(k)=dsin(k*theti2)
6684 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
6687 if (phii.ne.phii) phii=150.0
6691 ityp1=ithetyp((itype(i-2)))
6692 C propagation of chirality for glycine type
6694 cosph1(k)=dcos(k*phii)
6695 sinph1(k)=dsin(k*phii)
6700 ityp1=ithetyp((itype(i-2)))
6705 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6708 if (phii1.ne.phii1) phii1=150.0
6713 ityp3=ithetyp((itype(i)))
6715 cosph2(k)=dcos(k*phii1)
6716 sinph2(k)=dsin(k*phii1)
6720 ityp3=ithetyp((itype(i)))
6726 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
6729 ccl=cosph1(l)*cosph2(k-l)
6730 ssl=sinph1(l)*sinph2(k-l)
6731 scl=sinph1(l)*cosph2(k-l)
6732 csl=cosph1(l)*sinph2(k-l)
6733 cosph1ph2(l,k)=ccl-ssl
6734 cosph1ph2(k,l)=ccl+ssl
6735 sinph1ph2(l,k)=scl+csl
6736 sinph1ph2(k,l)=scl-csl
6740 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
6741 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6742 write (iout,*) "coskt and sinkt"
6744 write (iout,*) k,coskt(k),sinkt(k)
6748 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6749 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
6752 & write (iout,*) "k",k,"
6753 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
6754 & " ethetai",ethetai
6757 write (iout,*) "cosph and sinph"
6759 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6761 write (iout,*) "cosph1ph2 and sinph2ph2"
6764 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6765 & sinph1ph2(l,k),sinph1ph2(k,l)
6768 write(iout,*) "ethetai",ethetai
6773 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
6774 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
6775 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
6776 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6777 ethetai=ethetai+sinkt(m)*aux
6778 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6779 dephii=dephii+k*sinkt(m)*(
6780 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
6781 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6782 dephii1=dephii1+k*sinkt(m)*(
6783 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
6784 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6786 & write (iout,*) "m",m," k",k," bbthet",
6787 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
6788 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
6789 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
6790 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6791 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6794 C print *,"cosph1", (cosph1(k), k=1,nsingle)
6795 C print *,"cosph2", (cosph2(k), k=1,nsingle)
6796 C print *,"sinph1", (sinph1(k), k=1,nsingle)
6797 C print *,"sinph2", (sinph2(k), k=1,nsingle)
6799 & write(iout,*) "ethetai",ethetai
6800 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6804 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6805 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
6806 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6807 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6808 ethetai=ethetai+sinkt(m)*aux
6809 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6810 dephii=dephii+l*sinkt(m)*(
6811 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
6812 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6813 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6814 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6815 dephii1=dephii1+(k-l)*sinkt(m)*(
6816 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6817 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6818 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
6819 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6821 write (iout,*) "m",m," k",k," l",l," ffthet",
6822 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6823 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
6824 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6825 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
6826 & " ethetai",ethetai
6827 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6828 & cosph1ph2(k,l)*sinkt(m),
6829 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6838 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6839 & i,theta(i)*rad2deg,phii*rad2deg,
6840 & phii1*rad2deg,ethetai
6842 etheta=etheta+ethetai
6843 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6844 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6845 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
6849 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6850 do i=ithetaconstr_start,ithetaconstr_end
6851 itheta=itheta_constr(i)
6852 thetiii=theta(itheta)
6853 difi=pinorm(thetiii-theta_constr0(i))
6854 if (difi.gt.theta_drange(i)) then
6855 difi=difi-theta_drange(i)
6856 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6857 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6858 & +for_thet_constr(i)*difi**3
6859 else if (difi.lt.-drange(i)) then
6861 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6862 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6863 & +for_thet_constr(i)*difi**3
6867 if (energy_dec) then
6868 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6869 & i,itheta,rad2deg*thetiii,
6870 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6871 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6872 & gloc(itheta+nphi-2,icg)
6880 c-----------------------------------------------------------------------------
6881 subroutine esc(escloc)
6882 C Calculate the local energy of a side chain and its derivatives in the
6883 C corresponding virtual-bond valence angles THETA and the spherical angles
6885 implicit real*8 (a-h,o-z)
6886 include 'DIMENSIONS'
6887 include 'COMMON.GEO'
6888 include 'COMMON.LOCAL'
6889 include 'COMMON.VAR'
6890 include 'COMMON.INTERACT'
6891 include 'COMMON.DERIV'
6892 include 'COMMON.CHAIN'
6893 include 'COMMON.IOUNITS'
6894 include 'COMMON.NAMES'
6895 include 'COMMON.FFIELD'
6896 include 'COMMON.CONTROL'
6897 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6898 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6899 common /sccalc/ time11,time12,time112,theti,it,nlobit
6902 c write (iout,'(a)') 'ESC'
6903 do i=loc_start,loc_end
6905 if (it.eq.ntyp1) cycle
6906 if (it.eq.10) goto 1
6907 nlobit=nlob(iabs(it))
6908 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6909 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6910 theti=theta(i+1)-pipol
6915 if (x(2).gt.pi-delta) then
6919 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6921 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6922 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6924 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6925 & ddersc0(1),dersc(1))
6926 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6927 & ddersc0(3),dersc(3))
6929 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6931 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6932 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6933 & dersc0(2),esclocbi,dersc02)
6934 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6936 call splinthet(x(2),0.5d0*delta,ss,ssd)
6941 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6943 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6944 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6946 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6948 c write (iout,*) escloci
6949 else if (x(2).lt.delta) then
6953 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6955 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6956 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6958 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6959 & ddersc0(1),dersc(1))
6960 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6961 & ddersc0(3),dersc(3))
6963 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6965 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6966 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6967 & dersc0(2),esclocbi,dersc02)
6968 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6973 call splinthet(x(2),0.5d0*delta,ss,ssd)
6975 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6977 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6978 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6980 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6981 c write (iout,*) escloci
6983 call enesc(x,escloci,dersc,ddummy,.false.)
6986 escloc=escloc+escloci
6987 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6988 & 'escloc',i,escloci
6989 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6991 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6993 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6994 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6999 C---------------------------------------------------------------------------
7000 subroutine enesc(x,escloci,dersc,ddersc,mixed)
7001 implicit real*8 (a-h,o-z)
7002 include 'DIMENSIONS'
7003 include 'COMMON.GEO'
7004 include 'COMMON.LOCAL'
7005 include 'COMMON.IOUNITS'
7006 common /sccalc/ time11,time12,time112,theti,it,nlobit
7007 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
7008 double precision contr(maxlob,-1:1)
7010 c write (iout,*) 'it=',it,' nlobit=',nlobit
7014 if (mixed) ddersc(j)=0.0d0
7018 C Because of periodicity of the dependence of the SC energy in omega we have
7019 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
7020 C To avoid underflows, first compute & store the exponents.
7028 z(k)=x(k)-censc(k,j,it)
7033 Axk=Axk+gaussc(l,k,j,it)*z(l)
7039 expfac=expfac+Ax(k,j,iii)*z(k)
7047 C As in the case of ebend, we want to avoid underflows in exponentiation and
7048 C subsequent NaNs and INFs in energy calculation.
7049 C Find the largest exponent
7053 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
7057 cd print *,'it=',it,' emin=',emin
7059 C Compute the contribution to SC energy and derivatives
7064 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
7065 if(adexp.ne.adexp) adexp=1.0
7068 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
7070 cd print *,'j=',j,' expfac=',expfac
7071 escloc_i=escloc_i+expfac
7073 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
7077 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
7078 & +gaussc(k,2,j,it))*expfac
7085 dersc(1)=dersc(1)/cos(theti)**2
7086 ddersc(1)=ddersc(1)/cos(theti)**2
7089 escloci=-(dlog(escloc_i)-emin)
7091 dersc(j)=dersc(j)/escloc_i
7095 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
7100 C------------------------------------------------------------------------------
7101 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
7102 implicit real*8 (a-h,o-z)
7103 include 'DIMENSIONS'
7104 include 'COMMON.GEO'
7105 include 'COMMON.LOCAL'
7106 include 'COMMON.IOUNITS'
7107 common /sccalc/ time11,time12,time112,theti,it,nlobit
7108 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
7109 double precision contr(maxlob)
7120 z(k)=x(k)-censc(k,j,it)
7126 Axk=Axk+gaussc(l,k,j,it)*z(l)
7132 expfac=expfac+Ax(k,j)*z(k)
7137 C As in the case of ebend, we want to avoid underflows in exponentiation and
7138 C subsequent NaNs and INFs in energy calculation.
7139 C Find the largest exponent
7142 if (emin.gt.contr(j)) emin=contr(j)
7146 C Compute the contribution to SC energy and derivatives
7150 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
7151 escloc_i=escloc_i+expfac
7153 dersc(k)=dersc(k)+Ax(k,j)*expfac
7155 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
7156 & +gaussc(1,2,j,it))*expfac
7160 dersc(1)=dersc(1)/cos(theti)**2
7161 dersc12=dersc12/cos(theti)**2
7162 escloci=-(dlog(escloc_i)-emin)
7164 dersc(j)=dersc(j)/escloc_i
7166 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
7170 c----------------------------------------------------------------------------------
7171 subroutine esc(escloc)
7172 C Calculate the local energy of a side chain and its derivatives in the
7173 C corresponding virtual-bond valence angles THETA and the spherical angles
7174 C ALPHA and OMEGA derived from AM1 all-atom calculations.
7175 C added by Urszula Kozlowska. 07/11/2007
7177 implicit real*8 (a-h,o-z)
7178 include 'DIMENSIONS'
7179 include 'COMMON.GEO'
7180 include 'COMMON.LOCAL'
7181 include 'COMMON.VAR'
7182 include 'COMMON.SCROT'
7183 include 'COMMON.INTERACT'
7184 include 'COMMON.DERIV'
7185 include 'COMMON.CHAIN'
7186 include 'COMMON.IOUNITS'
7187 include 'COMMON.NAMES'
7188 include 'COMMON.FFIELD'
7189 include 'COMMON.CONTROL'
7190 include 'COMMON.VECTORS'
7191 double precision x_prime(3),y_prime(3),z_prime(3)
7192 & , sumene,dsc_i,dp2_i,x(65),
7193 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
7194 & de_dxx,de_dyy,de_dzz,de_dt
7195 double precision s1_t,s1_6_t,s2_t,s2_6_t
7197 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
7198 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
7199 & dt_dCi(3),dt_dCi1(3)
7200 common /sccalc/ time11,time12,time112,theti,it,nlobit
7203 do i=loc_start,loc_end
7204 if (itype(i).eq.ntyp1) cycle
7205 costtab(i+1) =dcos(theta(i+1))
7206 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
7207 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
7208 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
7209 cosfac2=0.5d0/(1.0d0+costtab(i+1))
7210 cosfac=dsqrt(cosfac2)
7211 sinfac2=0.5d0/(1.0d0-costtab(i+1))
7212 sinfac=dsqrt(sinfac2)
7214 if (it.eq.10) goto 1
7216 C Compute the axes of tghe local cartesian coordinates system; store in
7217 c x_prime, y_prime and z_prime
7224 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
7225 C & dc_norm(3,i+nres)
7227 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
7228 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
7231 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
7234 c write (2,*) "x_prime",(x_prime(j),j=1,3)
7235 c write (2,*) "y_prime",(y_prime(j),j=1,3)
7236 c write (2,*) "z_prime",(z_prime(j),j=1,3)
7237 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
7238 c & " xy",scalar(x_prime(1),y_prime(1)),
7239 c & " xz",scalar(x_prime(1),z_prime(1)),
7240 c & " yy",scalar(y_prime(1),y_prime(1)),
7241 c & " yz",scalar(y_prime(1),z_prime(1)),
7242 c & " zz",scalar(z_prime(1),z_prime(1))
7244 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
7245 C to local coordinate system. Store in xx, yy, zz.
7251 xx = xx + x_prime(j)*dc_norm(j,i+nres)
7252 yy = yy + y_prime(j)*dc_norm(j,i+nres)
7253 zz = zz + z_prime(j)*dc_norm(j,i+nres)
7260 C Compute the energy of the ith side cbain
7262 c write (2,*) "xx",xx," yy",yy," zz",zz
7265 x(j) = sc_parmin(j,it)
7268 Cc diagnostics - remove later
7270 yy1 = dsin(alph(2))*dcos(omeg(2))
7271 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
7272 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
7273 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
7275 C," --- ", xx_w,yy_w,zz_w
7278 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7279 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7281 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7282 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7284 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7285 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7286 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7287 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7288 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7290 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7291 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7292 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7293 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7294 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7296 dsc_i = 0.743d0+x(61)
7298 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7299 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
7300 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7301 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
7302 s1=(1+x(63))/(0.1d0 + dscp1)
7303 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7304 s2=(1+x(65))/(0.1d0 + dscp2)
7305 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7306 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
7307 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
7308 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
7310 c & dscp1,dscp2,sumene
7311 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7312 escloc = escloc + sumene
7313 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
7318 C This section to check the numerical derivatives of the energy of ith side
7319 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
7320 C #define DEBUG in the code to turn it on.
7322 write (2,*) "sumene =",sumene
7326 write (2,*) xx,yy,zz
7327 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7328 de_dxx_num=(sumenep-sumene)/aincr
7330 write (2,*) "xx+ sumene from enesc=",sumenep
7333 write (2,*) xx,yy,zz
7334 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7335 de_dyy_num=(sumenep-sumene)/aincr
7337 write (2,*) "yy+ sumene from enesc=",sumenep
7340 write (2,*) xx,yy,zz
7341 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7342 de_dzz_num=(sumenep-sumene)/aincr
7344 write (2,*) "zz+ sumene from enesc=",sumenep
7345 costsave=cost2tab(i+1)
7346 sintsave=sint2tab(i+1)
7347 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
7348 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
7349 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7350 de_dt_num=(sumenep-sumene)/aincr
7351 write (2,*) " t+ sumene from enesc=",sumenep
7352 cost2tab(i+1)=costsave
7353 sint2tab(i+1)=sintsave
7354 C End of diagnostics section.
7357 C Compute the gradient of esc
7359 c zz=zz*dsign(1.0,dfloat(itype(i)))
7360 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
7361 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
7362 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
7363 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
7364 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
7365 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
7366 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
7367 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
7368 pom1=(sumene3*sint2tab(i+1)+sumene1)
7369 & *(pom_s1/dscp1+pom_s16*dscp1**4)
7370 pom2=(sumene4*cost2tab(i+1)+sumene2)
7371 & *(pom_s2/dscp2+pom_s26*dscp2**4)
7372 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
7373 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
7374 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
7376 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
7377 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
7378 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
7380 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
7381 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
7382 & +(pom1+pom2)*pom_dx
7384 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
7387 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
7388 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
7389 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
7391 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
7392 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
7393 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
7394 & +x(59)*zz**2 +x(60)*xx*zz
7395 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
7396 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
7397 & +(pom1-pom2)*pom_dy
7399 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
7402 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
7403 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
7404 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
7405 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
7406 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
7407 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
7408 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
7409 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
7411 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
7414 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
7415 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
7416 & +pom1*pom_dt1+pom2*pom_dt2
7418 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
7423 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
7424 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
7425 cosfac2xx=cosfac2*xx
7426 sinfac2yy=sinfac2*yy
7428 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
7430 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
7432 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
7433 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
7434 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
7435 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
7436 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
7437 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
7438 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
7439 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
7440 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
7441 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
7445 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
7446 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
7447 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
7448 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
7451 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
7452 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
7453 dZZ_XYZ(k)=vbld_inv(i+nres)*
7454 & (z_prime(k)-zz*dC_norm(k,i+nres))
7456 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
7457 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
7461 dXX_Ctab(k,i)=dXX_Ci(k)
7462 dXX_C1tab(k,i)=dXX_Ci1(k)
7463 dYY_Ctab(k,i)=dYY_Ci(k)
7464 dYY_C1tab(k,i)=dYY_Ci1(k)
7465 dZZ_Ctab(k,i)=dZZ_Ci(k)
7466 dZZ_C1tab(k,i)=dZZ_Ci1(k)
7467 dXX_XYZtab(k,i)=dXX_XYZ(k)
7468 dYY_XYZtab(k,i)=dYY_XYZ(k)
7469 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
7473 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
7474 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
7475 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
7476 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
7477 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
7479 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
7480 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
7481 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
7482 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
7483 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
7484 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
7485 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
7486 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
7488 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
7489 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
7491 C to check gradient call subroutine check_grad
7497 c------------------------------------------------------------------------------
7498 double precision function enesc(x,xx,yy,zz,cost2,sint2)
7500 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
7501 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
7502 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7503 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7505 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7506 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7508 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7509 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7510 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7511 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7512 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7514 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7515 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7516 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7517 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7518 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7520 dsc_i = 0.743d0+x(61)
7522 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7523 & *(xx*cost2+yy*sint2))
7524 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7525 & *(xx*cost2-yy*sint2))
7526 s1=(1+x(63))/(0.1d0 + dscp1)
7527 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7528 s2=(1+x(65))/(0.1d0 + dscp2)
7529 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7530 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
7531 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
7536 c------------------------------------------------------------------------------
7537 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
7539 C This procedure calculates two-body contact function g(rij) and its derivative:
7542 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
7545 C where x=(rij-r0ij)/delta
7547 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
7550 double precision rij,r0ij,eps0ij,fcont,fprimcont
7551 double precision x,x2,x4,delta
7555 if (x.lt.-1.0D0) then
7558 else if (x.le.1.0D0) then
7561 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
7562 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7569 c------------------------------------------------------------------------------
7570 subroutine splinthet(theti,delta,ss,ssder)
7571 implicit real*8 (a-h,o-z)
7572 include 'DIMENSIONS'
7573 include 'COMMON.VAR'
7574 include 'COMMON.GEO'
7577 if (theti.gt.pipol) then
7578 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7580 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7585 c------------------------------------------------------------------------------
7586 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7588 double precision x,x0,delta,f0,f1,fprim0,f,fprim
7589 double precision ksi,ksi2,ksi3,a1,a2,a3
7590 a1=fprim0*delta/(f1-f0)
7596 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7597 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7600 c------------------------------------------------------------------------------
7601 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7603 double precision x,x0,delta,f0x,f1x,fprim0x,fx
7604 double precision ksi,ksi2,ksi3,a1,a2,a3
7609 a2=3*(f1x-f0x)-2*fprim0x*delta
7610 a3=fprim0x*delta-2*(f1x-f0x)
7611 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7614 C-----------------------------------------------------------------------------
7616 C-----------------------------------------------------------------------------
7617 subroutine etor(etors,edihcnstr)
7618 implicit real*8 (a-h,o-z)
7619 include 'DIMENSIONS'
7620 include 'COMMON.VAR'
7621 include 'COMMON.GEO'
7622 include 'COMMON.LOCAL'
7623 include 'COMMON.TORSION'
7624 include 'COMMON.INTERACT'
7625 include 'COMMON.DERIV'
7626 include 'COMMON.CHAIN'
7627 include 'COMMON.NAMES'
7628 include 'COMMON.IOUNITS'
7629 include 'COMMON.FFIELD'
7630 include 'COMMON.TORCNSTR'
7631 include 'COMMON.CONTROL'
7633 C Set lprn=.true. for debugging
7637 do i=iphi_start,iphi_end
7639 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7640 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7641 itori=itortyp(itype(i-2))
7642 itori1=itortyp(itype(i-1))
7645 C Proline-Proline pair is a special case...
7646 if (itori.eq.3 .and. itori1.eq.3) then
7647 if (phii.gt.-dwapi3) then
7649 fac=1.0D0/(1.0D0-cosphi)
7650 etorsi=v1(1,3,3)*fac
7651 etorsi=etorsi+etorsi
7652 etors=etors+etorsi-v1(1,3,3)
7653 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
7654 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7657 v1ij=v1(j+1,itori,itori1)
7658 v2ij=v2(j+1,itori,itori1)
7661 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7662 if (energy_dec) etors_ii=etors_ii+
7663 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7664 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7668 v1ij=v1(j,itori,itori1)
7669 v2ij=v2(j,itori,itori1)
7672 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7673 if (energy_dec) etors_ii=etors_ii+
7674 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7675 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7678 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7681 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7682 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7683 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7684 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7685 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7687 ! 6/20/98 - dihedral angle constraints
7690 itori=idih_constr(i)
7693 if (difi.gt.drange(i)) then
7695 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7696 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7697 else if (difi.lt.-drange(i)) then
7699 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
7700 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7702 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
7703 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7705 ! write (iout,*) 'edihcnstr',edihcnstr
7708 c------------------------------------------------------------------------------
7709 subroutine etor_d(etors_d)
7713 c----------------------------------------------------------------------------
7715 subroutine etor(etors,edihcnstr)
7716 implicit real*8 (a-h,o-z)
7717 include 'DIMENSIONS'
7718 include 'COMMON.VAR'
7719 include 'COMMON.GEO'
7720 include 'COMMON.LOCAL'
7721 include 'COMMON.TORSION'
7722 include 'COMMON.INTERACT'
7723 include 'COMMON.DERIV'
7724 include 'COMMON.CHAIN'
7725 include 'COMMON.NAMES'
7726 include 'COMMON.IOUNITS'
7727 include 'COMMON.FFIELD'
7728 include 'COMMON.TORCNSTR'
7729 include 'COMMON.CONTROL'
7731 C Set lprn=.true. for debugging
7735 do i=iphi_start,iphi_end
7736 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7737 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7738 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7739 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7740 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7741 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7742 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7743 C For introducing the NH3+ and COO- group please check the etor_d for reference
7746 if (iabs(itype(i)).eq.20) then
7751 itori=itortyp(itype(i-2))
7752 itori1=itortyp(itype(i-1))
7755 C Regular cosine and sine terms
7756 do j=1,nterm(itori,itori1,iblock)
7757 v1ij=v1(j,itori,itori1,iblock)
7758 v2ij=v2(j,itori,itori1,iblock)
7761 etors=etors+v1ij*cosphi+v2ij*sinphi
7762 if (energy_dec) etors_ii=etors_ii+
7763 & v1ij*cosphi+v2ij*sinphi
7764 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7768 C E = SUM ----------------------------------- - v1
7769 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7771 cosphi=dcos(0.5d0*phii)
7772 sinphi=dsin(0.5d0*phii)
7773 do j=1,nlor(itori,itori1,iblock)
7774 vl1ij=vlor1(j,itori,itori1)
7775 vl2ij=vlor2(j,itori,itori1)
7776 vl3ij=vlor3(j,itori,itori1)
7777 pom=vl2ij*cosphi+vl3ij*sinphi
7778 pom1=1.0d0/(pom*pom+1.0d0)
7779 etors=etors+vl1ij*pom1
7780 if (energy_dec) etors_ii=etors_ii+
7783 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7785 C Subtract the constant term
7786 etors=etors-v0(itori,itori1,iblock)
7787 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7788 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
7790 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7791 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7792 & (v1(j,itori,itori1,iblock),j=1,6),
7793 & (v2(j,itori,itori1,iblock),j=1,6)
7794 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7795 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7797 ! 6/20/98 - dihedral angle constraints
7799 c do i=1,ndih_constr
7800 do i=idihconstr_start,idihconstr_end
7801 itori=idih_constr(i)
7803 difi=pinorm(phii-phi0(i))
7804 if (difi.gt.drange(i)) then
7806 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7807 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7808 else if (difi.lt.-drange(i)) then
7810 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7811 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7815 if (energy_dec) then
7816 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
7817 & i,itori,rad2deg*phii,
7818 & rad2deg*phi0(i), rad2deg*drange(i),
7819 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
7822 cd write (iout,*) 'edihcnstr',edihcnstr
7825 c----------------------------------------------------------------------------
7826 subroutine etor_d(etors_d)
7827 C 6/23/01 Compute double torsional energy
7828 implicit real*8 (a-h,o-z)
7829 include 'DIMENSIONS'
7830 include 'COMMON.VAR'
7831 include 'COMMON.GEO'
7832 include 'COMMON.LOCAL'
7833 include 'COMMON.TORSION'
7834 include 'COMMON.INTERACT'
7835 include 'COMMON.DERIV'
7836 include 'COMMON.CHAIN'
7837 include 'COMMON.NAMES'
7838 include 'COMMON.IOUNITS'
7839 include 'COMMON.FFIELD'
7840 include 'COMMON.TORCNSTR'
7842 C Set lprn=.true. for debugging
7846 c write(iout,*) "a tu??"
7847 do i=iphid_start,iphid_end
7848 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7849 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7850 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7851 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7852 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7853 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7854 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7855 & (itype(i+1).eq.ntyp1)) cycle
7856 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7857 itori=itortyp(itype(i-2))
7858 itori1=itortyp(itype(i-1))
7859 itori2=itortyp(itype(i))
7865 if (iabs(itype(i+1)).eq.20) iblock=2
7866 C Iblock=2 Proline type
7867 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7868 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7869 C if (itype(i+1).eq.ntyp1) iblock=3
7870 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7871 C IS or IS NOT need for this
7872 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7873 C is (itype(i-3).eq.ntyp1) ntblock=2
7874 C ntblock is N-terminal blocking group
7876 C Regular cosine and sine terms
7877 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7878 C Example of changes for NH3+ blocking group
7879 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7880 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7881 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7882 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7883 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7884 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7885 cosphi1=dcos(j*phii)
7886 sinphi1=dsin(j*phii)
7887 cosphi2=dcos(j*phii1)
7888 sinphi2=dsin(j*phii1)
7889 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7890 & v2cij*cosphi2+v2sij*sinphi2
7891 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7892 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7894 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7896 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7897 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7898 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7899 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7900 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7901 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7902 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7903 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7904 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7905 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7906 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7907 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7908 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7909 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7912 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7913 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7918 C----------------------------------------------------------------------------------
7919 C The rigorous attempt to derive energy function
7920 subroutine etor_kcc(etors,edihcnstr)
7921 implicit real*8 (a-h,o-z)
7922 include 'DIMENSIONS'
7923 include 'COMMON.VAR'
7924 include 'COMMON.GEO'
7925 include 'COMMON.LOCAL'
7926 include 'COMMON.TORSION'
7927 include 'COMMON.INTERACT'
7928 include 'COMMON.DERIV'
7929 include 'COMMON.CHAIN'
7930 include 'COMMON.NAMES'
7931 include 'COMMON.IOUNITS'
7932 include 'COMMON.FFIELD'
7933 include 'COMMON.TORCNSTR'
7934 include 'COMMON.CONTROL'
7936 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
7937 C Set lprn=.true. for debugging
7940 C print *,"wchodze kcc"
7941 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
7942 if (tor_mode.ne.2) then
7945 do i=iphi_start,iphi_end
7946 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7947 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7948 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7949 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7950 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7951 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7952 itori=itortyp_kcc(itype(i-2))
7953 itori1=itortyp_kcc(itype(i-1))
7958 sumnonchebyshev=0.0d0
7960 C to avoid multiple devision by 2
7961 c theti22=0.5d0*theta(i)
7962 C theta 12 is the theta_1 /2
7963 C theta 22 is theta_2 /2
7964 c theti12=0.5d0*theta(i-1)
7965 C and appropriate sinus function
7966 sinthet1=dsin(theta(i-1))
7967 sinthet2=dsin(theta(i))
7968 costhet1=dcos(theta(i-1))
7969 costhet2=dcos(theta(i))
7970 c Cosines of halves thetas
7971 costheti12=0.5d0*(1.0d0+costhet1)
7972 costheti22=0.5d0*(1.0d0+costhet2)
7973 C to speed up lets store its mutliplication
7974 sint1t2=sinthet2*sinthet1
7976 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
7977 C +d_n*sin(n*gamma)) *
7978 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
7979 C we have two sum 1) Non-Chebyshev which is with n and gamma
7981 do j=1,nterm_kcc(itori,itori1)
7983 nval=nterm_kcc_Tb(itori,itori1)
7984 v1ij=v1_kcc(j,itori,itori1)
7985 v2ij=v2_kcc(j,itori,itori1)
7986 c write (iout,*) "i",i," j",j," v1",v1ij," v2",v2ij
7987 C v1ij is c_n and d_n in euation above
7991 sint1t2n=sint1t2n*sint1t2
7992 sumth1tyb1=tschebyshev(1,nval,v11_chyb(1,j,itori,itori1),
7994 gradth1tyb1=-0.5d0*sinthet1*gradtschebyshev(0,nval-1,
7995 & v11_chyb(1,j,itori,itori1),costheti12)
7996 c write (iout,*) "v11",(v11_chyb(k,j,itori,itori1),k=1,nval),
7997 c & " sumth1tyb1",sumth1tyb1," gradth1tyb1",gradth1tyb1
7998 sumth2tyb1=tschebyshev(1,nval,v21_chyb(1,j,itori,itori1),
8000 gradth2tyb1=-0.5d0*sinthet2*gradtschebyshev(0,nval-1,
8001 & v21_chyb(1,j,itori,itori1),costheti22)
8002 c write (iout,*) "v21",(v21_chyb(k,j,itori,itori1),k=1,nval),
8003 c & " sumth2tyb1",sumth2tyb1," gradth2tyb1",gradth2tyb1
8004 sumth1tyb2=tschebyshev(1,nval,v12_chyb(1,j,itori,itori1),
8006 gradth1tyb2=-0.5d0*sinthet1*gradtschebyshev(0,nval-1,
8007 & v12_chyb(1,j,itori,itori1),costheti12)
8008 c write (iout,*) "v12",(v12_chyb(k,j,itori,itori1),k=1,nval),
8009 c & " sumth1tyb2",sumth1tyb2," gradth1tyb2",gradth1tyb2
8010 sumth2tyb2=tschebyshev(1,nval,v22_chyb(1,j,itori,itori1),
8012 gradth2tyb2=-0.5d0*sinthet2*gradtschebyshev(0,nval-1,
8013 & v22_chyb(1,j,itori,itori1),costheti22)
8014 c write (iout,*) "v22",(v22_chyb(k,j,itori,itori1),k=1,nval),
8015 c & " sumth2tyb2",sumth2tyb2," gradth2tyb2",gradth2tyb2
8016 C etors=etors+sint1t2n*(v1ij*cosphi+v2ij*sinphi)
8017 C if (energy_dec) etors_ii=etors_ii+
8018 C & v1ij*cosphi+v2ij*sinphi
8019 C glocig is the gradient local i site in gamma
8020 actval1=v1ij*cosphi*(1.0d0+sumth1tyb1+sumth2tyb1)
8021 actval2=v2ij*sinphi*(1.0d0+sumth1tyb2+sumth2tyb2)
8022 etori=etori+sint1t2n*(actval1+actval2)
8024 & j*sint1t2n*(v2ij*cosphi*(1.0d0+sumth1tyb2+sumth2tyb2)
8025 & -v1ij*sinphi*(1.0d0+sumth1tyb1+sumth2tyb1))
8026 C now gradient over theta_1
8028 & j*sint1t2n1*costhet1*sinthet2*(actval1+actval2)+
8029 & sint1t2n*(v1ij*cosphi*gradth1tyb1+v2ij*sinphi*gradth1tyb2)
8031 & j*sint1t2n1*sinthet1*costhet2*(actval1+actval2)+
8032 & sint1t2n*(v1ij*cosphi*gradth2tyb1+v2ij*sinphi*gradth2tyb2)
8034 C now the Czebyshev polinominal sum
8035 c do k=1,nterm_kcc_Tb(itori,itori1)
8036 c thybt1(k)=v1_chyb(k,j,itori,itori1)
8037 c thybt2(k)=v2_chyb(k,j,itori,itori1)
8041 C print *, sumth1thyb, gradthybt1, sumth2thyb, gradthybt2,
8043 C & (0,nterm_kcc_Tb(itori,itori1)-1,thybt2(1),
8044 C & dcos(theti22)**2),
8047 C now overal sumation
8048 C print *,"sumnon", sumnonchebyshev,sumth1thyb+sumth2thyb
8051 C derivative over gamma
8052 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
8053 C derivative over theta1
8054 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
8055 C now derivative over theta2
8056 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
8058 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
8059 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
8061 C gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
8062 ! 6/20/98 - dihedral angle constraints
8063 if (tor_mode.ne.2) then
8065 c do i=1,ndih_constr
8066 do i=idihconstr_start,idihconstr_end
8067 itori=idih_constr(i)
8069 difi=pinorm(phii-phi0(i))
8070 if (difi.gt.drange(i)) then
8072 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
8073 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
8074 else if (difi.lt.-drange(i)) then
8076 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
8077 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
8086 C The rigorous attempt to derive energy function
8087 subroutine ebend_kcc(etheta,ethetacnstr)
8089 implicit real*8 (a-h,o-z)
8090 include 'DIMENSIONS'
8091 include 'COMMON.VAR'
8092 include 'COMMON.GEO'
8093 include 'COMMON.LOCAL'
8094 include 'COMMON.TORSION'
8095 include 'COMMON.INTERACT'
8096 include 'COMMON.DERIV'
8097 include 'COMMON.CHAIN'
8098 include 'COMMON.NAMES'
8099 include 'COMMON.IOUNITS'
8100 include 'COMMON.FFIELD'
8101 include 'COMMON.TORCNSTR'
8102 include 'COMMON.CONTROL'
8104 double precision thybt1(maxtermkcc)
8105 C Set lprn=.true. for debugging
8108 C print *,"wchodze kcc"
8109 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
8110 if (tor_mode.ne.2) etheta=0.0D0
8111 do i=ithet_start,ithet_end
8112 c print *,i,itype(i-1),itype(i),itype(i-2)
8113 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
8114 & .or.itype(i).eq.ntyp1) cycle
8115 iti=itortyp_kcc(itype(i-1))
8116 sinthet=dsin(theta(i)/2.0d0)
8117 costhet=dcos(theta(i)/2.0d0)
8118 do j=1,nbend_kcc_Tb(iti)
8119 thybt1(j)=v1bend_chyb(j,iti)
8121 sumth1thyb=tschebyshev
8122 & (1,nbend_kcc_Tb(iti),thybt1(1),costhet)
8123 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
8125 ihelp=nbend_kcc_Tb(iti)-1
8126 gradthybt1=gradtschebyshev
8127 & (0,ihelp,thybt1(1),costhet)
8128 etheta=etheta+sumth1thyb
8129 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
8130 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*
8131 & gradthybt1*sinthet*(-0.5d0)
8133 if (tor_mode.ne.2) then
8135 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
8136 do i=ithetaconstr_start,ithetaconstr_end
8137 itheta=itheta_constr(i)
8138 thetiii=theta(itheta)
8139 difi=pinorm(thetiii-theta_constr0(i))
8140 if (difi.gt.theta_drange(i)) then
8141 difi=difi-theta_drange(i)
8142 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
8143 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
8144 & +for_thet_constr(i)*difi**3
8145 else if (difi.lt.-drange(i)) then
8147 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
8148 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
8149 & +for_thet_constr(i)*difi**3
8153 if (energy_dec) then
8154 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
8155 & i,itheta,rad2deg*thetiii,
8156 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
8157 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
8158 & gloc(itheta+nphi-2,icg)
8164 c------------------------------------------------------------------------------
8165 subroutine eback_sc_corr(esccor)
8166 c 7/21/2007 Correlations between the backbone-local and side-chain-local
8167 c conformational states; temporarily implemented as differences
8168 c between UNRES torsional potentials (dependent on three types of
8169 c residues) and the torsional potentials dependent on all 20 types
8170 c of residues computed from AM1 energy surfaces of terminally-blocked
8171 c amino-acid residues.
8172 implicit real*8 (a-h,o-z)
8173 include 'DIMENSIONS'
8174 include 'COMMON.VAR'
8175 include 'COMMON.GEO'
8176 include 'COMMON.LOCAL'
8177 include 'COMMON.TORSION'
8178 include 'COMMON.SCCOR'
8179 include 'COMMON.INTERACT'
8180 include 'COMMON.DERIV'
8181 include 'COMMON.CHAIN'
8182 include 'COMMON.NAMES'
8183 include 'COMMON.IOUNITS'
8184 include 'COMMON.FFIELD'
8185 include 'COMMON.CONTROL'
8187 C Set lprn=.true. for debugging
8190 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
8192 do i=itau_start,itau_end
8193 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
8195 isccori=isccortyp(itype(i-2))
8196 isccori1=isccortyp(itype(i-1))
8197 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
8199 do intertyp=1,3 !intertyp
8200 cc Added 09 May 2012 (Adasko)
8201 cc Intertyp means interaction type of backbone mainchain correlation:
8202 c 1 = SC...Ca...Ca...Ca
8203 c 2 = Ca...Ca...Ca...SC
8204 c 3 = SC...Ca...Ca...SCi
8206 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
8207 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
8208 & (itype(i-1).eq.ntyp1)))
8209 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
8210 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
8211 & .or.(itype(i).eq.ntyp1)))
8212 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
8213 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
8214 & (itype(i-3).eq.ntyp1)))) cycle
8215 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
8216 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
8218 do j=1,nterm_sccor(isccori,isccori1)
8219 v1ij=v1sccor(j,intertyp,isccori,isccori1)
8220 v2ij=v2sccor(j,intertyp,isccori,isccori1)
8221 cosphi=dcos(j*tauangle(intertyp,i))
8222 sinphi=dsin(j*tauangle(intertyp,i))
8223 esccor=esccor+v1ij*cosphi+v2ij*sinphi
8224 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
8226 if (energy_dec) write(iout,'(a9,2i4,f8.3,3i4)') "esccor",i,j,
8229 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
8230 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
8232 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
8233 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
8234 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
8235 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
8236 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
8242 c----------------------------------------------------------------------------
8243 subroutine multibody(ecorr)
8244 C This subroutine calculates multi-body contributions to energy following
8245 C the idea of Skolnick et al. If side chains I and J make a contact and
8246 C at the same time side chains I+1 and J+1 make a contact, an extra
8247 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
8248 implicit real*8 (a-h,o-z)
8249 include 'DIMENSIONS'
8250 include 'COMMON.IOUNITS'
8251 include 'COMMON.DERIV'
8252 include 'COMMON.INTERACT'
8253 include 'COMMON.CONTACTS'
8254 double precision gx(3),gx1(3)
8257 C Set lprn=.true. for debugging
8261 write (iout,'(a)') 'Contact function values:'
8263 write (iout,'(i2,20(1x,i2,f10.5))')
8264 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
8279 num_conti=num_cont(i)
8280 num_conti1=num_cont(i1)
8285 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
8286 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8287 cd & ' ishift=',ishift
8288 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
8289 C The system gains extra energy.
8290 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
8291 endif ! j1==j+-ishift
8300 c------------------------------------------------------------------------------
8301 double precision function esccorr(i,j,k,l,jj,kk)
8302 implicit real*8 (a-h,o-z)
8303 include 'DIMENSIONS'
8304 include 'COMMON.IOUNITS'
8305 include 'COMMON.DERIV'
8306 include 'COMMON.INTERACT'
8307 include 'COMMON.CONTACTS'
8308 include 'COMMON.SHIELD'
8309 double precision gx(3),gx1(3)
8314 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
8315 C Calculate the multi-body contribution to energy.
8316 C Calculate multi-body contributions to the gradient.
8317 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
8318 cd & k,l,(gacont(m,kk,k),m=1,3)
8320 gx(m) =ekl*gacont(m,jj,i)
8321 gx1(m)=eij*gacont(m,kk,k)
8322 gradxorr(m,i)=gradxorr(m,i)-gx(m)
8323 gradxorr(m,j)=gradxorr(m,j)+gx(m)
8324 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
8325 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
8329 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
8334 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
8340 c------------------------------------------------------------------------------
8341 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
8342 C This subroutine calculates multi-body contributions to hydrogen-bonding
8343 implicit real*8 (a-h,o-z)
8344 include 'DIMENSIONS'
8345 include 'COMMON.IOUNITS'
8348 parameter (max_cont=maxconts)
8349 parameter (max_dim=26)
8350 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8351 double precision zapas(max_dim,maxconts,max_fg_procs),
8352 & zapas_recv(max_dim,maxconts,max_fg_procs)
8353 common /przechowalnia/ zapas
8354 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8355 & status_array(MPI_STATUS_SIZE,maxconts*2)
8357 include 'COMMON.SETUP'
8358 include 'COMMON.FFIELD'
8359 include 'COMMON.DERIV'
8360 include 'COMMON.INTERACT'
8361 include 'COMMON.CONTACTS'
8362 include 'COMMON.CONTROL'
8363 include 'COMMON.LOCAL'
8364 double precision gx(3),gx1(3),time00
8367 C Set lprn=.true. for debugging
8372 if (nfgtasks.le.1) goto 30
8374 write (iout,'(a)') 'Contact function values before RECEIVE:'
8376 write (iout,'(2i3,50(1x,i2,f5.2))')
8377 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8378 & j=1,num_cont_hb(i))
8382 do i=1,ntask_cont_from
8385 do i=1,ntask_cont_to
8388 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8390 C Make the list of contacts to send to send to other procesors
8391 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
8393 do i=iturn3_start,iturn3_end
8394 c write (iout,*) "make contact list turn3",i," num_cont",
8396 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
8398 do i=iturn4_start,iturn4_end
8399 c write (iout,*) "make contact list turn4",i," num_cont",
8401 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
8405 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8407 do j=1,num_cont_hb(i)
8410 iproc=iint_sent_local(k,jjc,ii)
8411 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8412 if (iproc.gt.0) then
8413 ncont_sent(iproc)=ncont_sent(iproc)+1
8414 nn=ncont_sent(iproc)
8416 zapas(2,nn,iproc)=jjc
8417 zapas(3,nn,iproc)=facont_hb(j,i)
8418 zapas(4,nn,iproc)=ees0p(j,i)
8419 zapas(5,nn,iproc)=ees0m(j,i)
8420 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
8421 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
8422 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
8423 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
8424 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
8425 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
8426 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
8427 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
8428 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
8429 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
8430 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
8431 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
8432 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
8433 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
8434 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
8435 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
8436 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
8437 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
8438 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
8439 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
8440 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
8447 & "Numbers of contacts to be sent to other processors",
8448 & (ncont_sent(i),i=1,ntask_cont_to)
8449 write (iout,*) "Contacts sent"
8450 do ii=1,ntask_cont_to
8452 iproc=itask_cont_to(ii)
8453 write (iout,*) nn," contacts to processor",iproc,
8454 & " of CONT_TO_COMM group"
8456 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8464 CorrelID1=nfgtasks+fg_rank+1
8466 C Receive the numbers of needed contacts from other processors
8467 do ii=1,ntask_cont_from
8468 iproc=itask_cont_from(ii)
8470 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8471 & FG_COMM,req(ireq),IERR)
8473 c write (iout,*) "IRECV ended"
8475 C Send the number of contacts needed by other processors
8476 do ii=1,ntask_cont_to
8477 iproc=itask_cont_to(ii)
8479 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8480 & FG_COMM,req(ireq),IERR)
8482 c write (iout,*) "ISEND ended"
8483 c write (iout,*) "number of requests (nn)",ireq
8486 & call MPI_Waitall(ireq,req,status_array,ierr)
8488 c & "Numbers of contacts to be received from other processors",
8489 c & (ncont_recv(i),i=1,ntask_cont_from)
8493 do ii=1,ntask_cont_from
8494 iproc=itask_cont_from(ii)
8496 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8497 c & " of CONT_TO_COMM group"
8501 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8502 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8503 c write (iout,*) "ireq,req",ireq,req(ireq)
8506 C Send the contacts to processors that need them
8507 do ii=1,ntask_cont_to
8508 iproc=itask_cont_to(ii)
8510 c write (iout,*) nn," contacts to processor",iproc,
8511 c & " of CONT_TO_COMM group"
8514 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8515 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8516 c write (iout,*) "ireq,req",ireq,req(ireq)
8518 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8522 c write (iout,*) "number of requests (contacts)",ireq
8523 c write (iout,*) "req",(req(i),i=1,4)
8526 & call MPI_Waitall(ireq,req,status_array,ierr)
8527 do iii=1,ntask_cont_from
8528 iproc=itask_cont_from(iii)
8531 write (iout,*) "Received",nn," contacts from processor",iproc,
8532 & " of CONT_FROM_COMM group"
8535 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8540 ii=zapas_recv(1,i,iii)
8541 c Flag the received contacts to prevent double-counting
8542 jj=-zapas_recv(2,i,iii)
8543 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8545 nnn=num_cont_hb(ii)+1
8548 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8549 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8550 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8551 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8552 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8553 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8554 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8555 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8556 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8557 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8558 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8559 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8560 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8561 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8562 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8563 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8564 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8565 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8566 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8567 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8568 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8569 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8570 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8571 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8576 write (iout,'(a)') 'Contact function values after receive:'
8578 write (iout,'(2i3,50(1x,i3,f5.2))')
8579 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8580 & j=1,num_cont_hb(i))
8587 write (iout,'(a)') 'Contact function values:'
8589 write (iout,'(2i3,50(1x,i3,f5.2))')
8590 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8591 & j=1,num_cont_hb(i))
8595 C Remove the loop below after debugging !!!
8602 C Calculate the local-electrostatic correlation terms
8603 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8605 num_conti=num_cont_hb(i)
8606 num_conti1=num_cont_hb(i+1)
8613 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8614 c & ' jj=',jj,' kk=',kk
8615 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8616 & .or. j.lt.0 .and. j1.gt.0) .and.
8617 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8618 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8619 C The system gains extra energy.
8620 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8621 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
8622 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
8624 else if (j1.eq.j) then
8625 C Contacts I-J and I-(J+1) occur simultaneously.
8626 C The system loses extra energy.
8627 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8632 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8633 c & ' jj=',jj,' kk=',kk
8635 C Contacts I-J and (I+1)-J occur simultaneously.
8636 C The system loses extra energy.
8637 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8644 c------------------------------------------------------------------------------
8645 subroutine add_hb_contact(ii,jj,itask)
8646 implicit real*8 (a-h,o-z)
8647 include "DIMENSIONS"
8648 include "COMMON.IOUNITS"
8651 parameter (max_cont=maxconts)
8652 parameter (max_dim=26)
8653 include "COMMON.CONTACTS"
8654 double precision zapas(max_dim,maxconts,max_fg_procs),
8655 & zapas_recv(max_dim,maxconts,max_fg_procs)
8656 common /przechowalnia/ zapas
8657 integer i,j,ii,jj,iproc,itask(4),nn
8658 c write (iout,*) "itask",itask
8661 if (iproc.gt.0) then
8662 do j=1,num_cont_hb(ii)
8664 c write (iout,*) "i",ii," j",jj," jjc",jjc
8666 ncont_sent(iproc)=ncont_sent(iproc)+1
8667 nn=ncont_sent(iproc)
8668 zapas(1,nn,iproc)=ii
8669 zapas(2,nn,iproc)=jjc
8670 zapas(3,nn,iproc)=facont_hb(j,ii)
8671 zapas(4,nn,iproc)=ees0p(j,ii)
8672 zapas(5,nn,iproc)=ees0m(j,ii)
8673 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8674 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8675 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8676 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8677 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8678 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8679 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8680 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8681 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8682 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8683 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8684 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8685 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8686 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8687 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8688 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8689 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8690 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8691 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8692 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8693 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8701 c------------------------------------------------------------------------------
8702 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8704 C This subroutine calculates multi-body contributions to hydrogen-bonding
8705 implicit real*8 (a-h,o-z)
8706 include 'DIMENSIONS'
8707 include 'COMMON.IOUNITS'
8710 parameter (max_cont=maxconts)
8711 parameter (max_dim=70)
8712 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8713 double precision zapas(max_dim,maxconts,max_fg_procs),
8714 & zapas_recv(max_dim,maxconts,max_fg_procs)
8715 common /przechowalnia/ zapas
8716 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8717 & status_array(MPI_STATUS_SIZE,maxconts*2)
8719 include 'COMMON.SETUP'
8720 include 'COMMON.FFIELD'
8721 include 'COMMON.DERIV'
8722 include 'COMMON.LOCAL'
8723 include 'COMMON.INTERACT'
8724 include 'COMMON.CONTACTS'
8725 include 'COMMON.CHAIN'
8726 include 'COMMON.CONTROL'
8727 include 'COMMON.SHIELD'
8728 double precision gx(3),gx1(3)
8729 integer num_cont_hb_old(maxres)
8731 double precision eello4,eello5,eelo6,eello_turn6
8732 external eello4,eello5,eello6,eello_turn6
8733 C Set lprn=.true. for debugging
8738 num_cont_hb_old(i)=num_cont_hb(i)
8742 if (nfgtasks.le.1) goto 30
8744 write (iout,'(a)') 'Contact function values before RECEIVE:'
8746 write (iout,'(2i3,50(1x,i2,f5.2))')
8747 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8748 & j=1,num_cont_hb(i))
8752 do i=1,ntask_cont_from
8755 do i=1,ntask_cont_to
8758 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8760 C Make the list of contacts to send to send to other procesors
8761 do i=iturn3_start,iturn3_end
8762 c write (iout,*) "make contact list turn3",i," num_cont",
8764 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8766 do i=iturn4_start,iturn4_end
8767 c write (iout,*) "make contact list turn4",i," num_cont",
8769 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8773 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8775 do j=1,num_cont_hb(i)
8778 iproc=iint_sent_local(k,jjc,ii)
8779 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8780 if (iproc.ne.0) then
8781 ncont_sent(iproc)=ncont_sent(iproc)+1
8782 nn=ncont_sent(iproc)
8784 zapas(2,nn,iproc)=jjc
8785 zapas(3,nn,iproc)=d_cont(j,i)
8789 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8794 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8802 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8813 & "Numbers of contacts to be sent to other processors",
8814 & (ncont_sent(i),i=1,ntask_cont_to)
8815 write (iout,*) "Contacts sent"
8816 do ii=1,ntask_cont_to
8818 iproc=itask_cont_to(ii)
8819 write (iout,*) nn," contacts to processor",iproc,
8820 & " of CONT_TO_COMM group"
8822 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8830 CorrelID1=nfgtasks+fg_rank+1
8832 C Receive the numbers of needed contacts from other processors
8833 do ii=1,ntask_cont_from
8834 iproc=itask_cont_from(ii)
8836 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8837 & FG_COMM,req(ireq),IERR)
8839 c write (iout,*) "IRECV ended"
8841 C Send the number of contacts needed by other processors
8842 do ii=1,ntask_cont_to
8843 iproc=itask_cont_to(ii)
8845 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8846 & FG_COMM,req(ireq),IERR)
8848 c write (iout,*) "ISEND ended"
8849 c write (iout,*) "number of requests (nn)",ireq
8852 & call MPI_Waitall(ireq,req,status_array,ierr)
8854 c & "Numbers of contacts to be received from other processors",
8855 c & (ncont_recv(i),i=1,ntask_cont_from)
8859 do ii=1,ntask_cont_from
8860 iproc=itask_cont_from(ii)
8862 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8863 c & " of CONT_TO_COMM group"
8867 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8868 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8869 c write (iout,*) "ireq,req",ireq,req(ireq)
8872 C Send the contacts to processors that need them
8873 do ii=1,ntask_cont_to
8874 iproc=itask_cont_to(ii)
8876 c write (iout,*) nn," contacts to processor",iproc,
8877 c & " of CONT_TO_COMM group"
8880 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8881 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8882 c write (iout,*) "ireq,req",ireq,req(ireq)
8884 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8888 c write (iout,*) "number of requests (contacts)",ireq
8889 c write (iout,*) "req",(req(i),i=1,4)
8892 & call MPI_Waitall(ireq,req,status_array,ierr)
8893 do iii=1,ntask_cont_from
8894 iproc=itask_cont_from(iii)
8897 write (iout,*) "Received",nn," contacts from processor",iproc,
8898 & " of CONT_FROM_COMM group"
8901 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8906 ii=zapas_recv(1,i,iii)
8907 c Flag the received contacts to prevent double-counting
8908 jj=-zapas_recv(2,i,iii)
8909 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8911 nnn=num_cont_hb(ii)+1
8914 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8918 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8923 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8931 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8940 write (iout,'(a)') 'Contact function values after receive:'
8942 write (iout,'(2i3,50(1x,i3,5f6.3))')
8943 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8944 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8951 write (iout,'(a)') 'Contact function values:'
8953 write (iout,'(2i3,50(1x,i2,5f6.3))')
8954 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8955 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8961 C Remove the loop below after debugging !!!
8968 C Calculate the dipole-dipole interaction energies
8969 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8970 do i=iatel_s,iatel_e+1
8971 num_conti=num_cont_hb(i)
8980 C Calculate the local-electrostatic correlation terms
8981 c write (iout,*) "gradcorr5 in eello5 before loop"
8983 c write (iout,'(i5,3f10.5)')
8984 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8986 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8987 c write (iout,*) "corr loop i",i
8989 num_conti=num_cont_hb(i)
8990 num_conti1=num_cont_hb(i+1)
8997 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8998 c & ' jj=',jj,' kk=',kk
8999 c if (j1.eq.j+1 .or. j1.eq.j-1) then
9000 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
9001 & .or. j.lt.0 .and. j1.gt.0) .and.
9002 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
9003 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
9004 C The system gains extra energy.
9006 sqd1=dsqrt(d_cont(jj,i))
9007 sqd2=dsqrt(d_cont(kk,i1))
9008 sred_geom = sqd1*sqd2
9009 IF (sred_geom.lt.cutoff_corr) THEN
9010 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
9012 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
9013 cd & ' jj=',jj,' kk=',kk
9014 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
9015 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
9017 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
9018 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
9021 cd write (iout,*) 'sred_geom=',sred_geom,
9022 cd & ' ekont=',ekont,' fprim=',fprimcont,
9023 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
9024 cd write (iout,*) "g_contij",g_contij
9025 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
9026 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
9027 call calc_eello(i,jp,i+1,jp1,jj,kk)
9028 if (wcorr4.gt.0.0d0)
9029 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
9030 CC & *fac_shield(i)**2*fac_shield(j)**2
9031 if (energy_dec.and.wcorr4.gt.0.0d0)
9032 1 write (iout,'(a6,4i5,0pf7.3)')
9033 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
9034 c write (iout,*) "gradcorr5 before eello5"
9036 c write (iout,'(i5,3f10.5)')
9037 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
9039 if (wcorr5.gt.0.0d0)
9040 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
9041 c write (iout,*) "gradcorr5 after eello5"
9043 c write (iout,'(i5,3f10.5)')
9044 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
9046 if (energy_dec.and.wcorr5.gt.0.0d0)
9047 1 write (iout,'(a6,4i5,0pf7.3)')
9048 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
9049 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
9050 cd write(2,*)'ijkl',i,jp,i+1,jp1
9051 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
9052 & .or. wturn6.eq.0.0d0))then
9053 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
9054 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
9055 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
9056 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
9057 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
9058 cd & 'ecorr6=',ecorr6
9059 cd write (iout,'(4e15.5)') sred_geom,
9060 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
9061 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
9062 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
9063 else if (wturn6.gt.0.0d0
9064 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
9065 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
9066 eturn6=eturn6+eello_turn6(i,jj,kk)
9067 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
9068 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
9069 cd write (2,*) 'multibody_eello:eturn6',eturn6
9078 num_cont_hb(i)=num_cont_hb_old(i)
9080 c write (iout,*) "gradcorr5 in eello5"
9082 c write (iout,'(i5,3f10.5)')
9083 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
9087 c------------------------------------------------------------------------------
9088 subroutine add_hb_contact_eello(ii,jj,itask)
9089 implicit real*8 (a-h,o-z)
9090 include "DIMENSIONS"
9091 include "COMMON.IOUNITS"
9094 parameter (max_cont=maxconts)
9095 parameter (max_dim=70)
9096 include "COMMON.CONTACTS"
9097 double precision zapas(max_dim,maxconts,max_fg_procs),
9098 & zapas_recv(max_dim,maxconts,max_fg_procs)
9099 common /przechowalnia/ zapas
9100 integer i,j,ii,jj,iproc,itask(4),nn
9101 c write (iout,*) "itask",itask
9104 if (iproc.gt.0) then
9105 do j=1,num_cont_hb(ii)
9107 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
9109 ncont_sent(iproc)=ncont_sent(iproc)+1
9110 nn=ncont_sent(iproc)
9111 zapas(1,nn,iproc)=ii
9112 zapas(2,nn,iproc)=jjc
9113 zapas(3,nn,iproc)=d_cont(j,ii)
9117 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
9122 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
9130 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
9142 c------------------------------------------------------------------------------
9143 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
9144 implicit real*8 (a-h,o-z)
9145 include 'DIMENSIONS'
9146 include 'COMMON.IOUNITS'
9147 include 'COMMON.DERIV'
9148 include 'COMMON.INTERACT'
9149 include 'COMMON.CONTACTS'
9150 include 'COMMON.SHIELD'
9151 include 'COMMON.CONTROL'
9152 double precision gx(3),gx1(3)
9155 C print *,"wchodze",fac_shield(i),shield_mode
9163 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
9165 C & fac_shield(i)**2*fac_shield(j)**2
9166 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
9167 C Following 4 lines for diagnostics.
9172 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
9173 c & 'Contacts ',i,j,
9174 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
9175 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
9177 C Calculate the multi-body contribution to energy.
9178 C ecorr=ecorr+ekont*ees
9179 C Calculate multi-body contributions to the gradient.
9180 coeffpees0pij=coeffp*ees0pij
9181 coeffmees0mij=coeffm*ees0mij
9182 coeffpees0pkl=coeffp*ees0pkl
9183 coeffmees0mkl=coeffm*ees0mkl
9185 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
9186 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
9187 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
9188 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
9189 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
9190 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
9191 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
9192 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
9193 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
9194 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
9195 & coeffmees0mij*gacontm_hb1(ll,kk,k))
9196 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
9197 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
9198 & coeffmees0mij*gacontm_hb2(ll,kk,k))
9199 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
9200 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
9201 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
9202 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
9203 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
9204 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
9205 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
9206 & coeffmees0mij*gacontm_hb3(ll,kk,k))
9207 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
9208 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
9209 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
9214 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
9215 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
9216 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
9217 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
9222 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
9223 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
9224 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
9225 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
9228 c write (iout,*) "ehbcorr",ekont*ees
9229 C print *,ekont,ees,i,k
9231 C now gradient over shielding
9233 if (shield_mode.gt.0) then
9236 C print *,i,j,fac_shield(i),fac_shield(j),
9237 C &fac_shield(k),fac_shield(l)
9238 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
9239 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
9240 do ilist=1,ishield_list(i)
9241 iresshield=shield_list(ilist,i)
9243 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
9245 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
9247 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
9248 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
9252 do ilist=1,ishield_list(j)
9253 iresshield=shield_list(ilist,j)
9255 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
9257 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
9259 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
9260 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
9265 do ilist=1,ishield_list(k)
9266 iresshield=shield_list(ilist,k)
9268 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
9270 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
9272 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
9273 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
9277 do ilist=1,ishield_list(l)
9278 iresshield=shield_list(ilist,l)
9280 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
9282 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
9284 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
9285 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
9289 C print *,gshieldx(m,iresshield)
9291 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
9292 & grad_shield(m,i)*ehbcorr/fac_shield(i)
9293 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
9294 & grad_shield(m,j)*ehbcorr/fac_shield(j)
9295 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
9296 & grad_shield(m,i)*ehbcorr/fac_shield(i)
9297 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
9298 & grad_shield(m,j)*ehbcorr/fac_shield(j)
9300 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
9301 & grad_shield(m,k)*ehbcorr/fac_shield(k)
9302 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
9303 & grad_shield(m,l)*ehbcorr/fac_shield(l)
9304 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
9305 & grad_shield(m,k)*ehbcorr/fac_shield(k)
9306 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
9307 & grad_shield(m,l)*ehbcorr/fac_shield(l)
9315 C---------------------------------------------------------------------------
9316 subroutine dipole(i,j,jj)
9317 implicit real*8 (a-h,o-z)
9318 include 'DIMENSIONS'
9319 include 'COMMON.IOUNITS'
9320 include 'COMMON.CHAIN'
9321 include 'COMMON.FFIELD'
9322 include 'COMMON.DERIV'
9323 include 'COMMON.INTERACT'
9324 include 'COMMON.CONTACTS'
9325 include 'COMMON.TORSION'
9326 include 'COMMON.VAR'
9327 include 'COMMON.GEO'
9328 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
9330 iti1 = itortyp(itype(i+1))
9331 if (j.lt.nres-1) then
9332 itj1 = itype2loc(itype(j+1))
9337 dipi(iii,1)=Ub2(iii,i)
9338 dipderi(iii)=Ub2der(iii,i)
9339 dipi(iii,2)=b1(iii,i+1)
9340 dipj(iii,1)=Ub2(iii,j)
9341 dipderj(iii)=Ub2der(iii,j)
9342 dipj(iii,2)=b1(iii,j+1)
9346 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
9349 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
9356 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
9360 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
9365 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
9366 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
9368 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
9370 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
9372 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
9377 C---------------------------------------------------------------------------
9378 subroutine calc_eello(i,j,k,l,jj,kk)
9380 C This subroutine computes matrices and vectors needed to calculate
9381 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
9383 implicit real*8 (a-h,o-z)
9384 include 'DIMENSIONS'
9385 include 'COMMON.IOUNITS'
9386 include 'COMMON.CHAIN'
9387 include 'COMMON.DERIV'
9388 include 'COMMON.INTERACT'
9389 include 'COMMON.CONTACTS'
9390 include 'COMMON.TORSION'
9391 include 'COMMON.VAR'
9392 include 'COMMON.GEO'
9393 include 'COMMON.FFIELD'
9394 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
9395 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
9398 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
9399 cd & ' jj=',jj,' kk=',kk
9400 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
9401 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
9402 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
9405 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
9406 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
9409 call transpose2(aa1(1,1),aa1t(1,1))
9410 call transpose2(aa2(1,1),aa2t(1,1))
9413 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
9414 & aa1tder(1,1,lll,kkk))
9415 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
9416 & aa2tder(1,1,lll,kkk))
9420 C parallel orientation of the two CA-CA-CA frames.
9422 iti=itype2loc(itype(i))
9426 itk1=itype2loc(itype(k+1))
9427 itj=itype2loc(itype(j))
9428 if (l.lt.nres-1) then
9429 itl1=itype2loc(itype(l+1))
9433 C A1 kernel(j+1) A2T
9435 cd write (iout,'(3f10.5,5x,3f10.5)')
9436 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
9438 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9439 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
9440 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9441 C Following matrices are needed only for 6-th order cumulants
9442 IF (wcorr6.gt.0.0d0) THEN
9443 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9444 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
9445 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9446 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9447 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
9448 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9449 & ADtEAderx(1,1,1,1,1,1))
9451 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9452 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
9453 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9454 & ADtEA1derx(1,1,1,1,1,1))
9456 C End 6-th order cumulants
9459 cd write (2,*) 'In calc_eello6'
9461 cd write (2,*) 'iii=',iii
9463 cd write (2,*) 'kkk=',kkk
9465 cd write (2,'(3(2f10.5),5x)')
9466 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9471 call transpose2(EUgder(1,1,k),auxmat(1,1))
9472 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9473 call transpose2(EUg(1,1,k),auxmat(1,1))
9474 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9475 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9479 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9480 & EAEAderx(1,1,lll,kkk,iii,1))
9484 C A1T kernel(i+1) A2
9485 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9486 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
9487 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9488 C Following matrices are needed only for 6-th order cumulants
9489 IF (wcorr6.gt.0.0d0) THEN
9490 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9491 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
9492 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9493 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9494 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
9495 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9496 & ADtEAderx(1,1,1,1,1,2))
9497 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9498 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
9499 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9500 & ADtEA1derx(1,1,1,1,1,2))
9502 C End 6-th order cumulants
9503 call transpose2(EUgder(1,1,l),auxmat(1,1))
9504 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
9505 call transpose2(EUg(1,1,l),auxmat(1,1))
9506 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9507 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9511 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9512 & EAEAderx(1,1,lll,kkk,iii,2))
9517 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9518 C They are needed only when the fifth- or the sixth-order cumulants are
9520 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
9521 call transpose2(AEA(1,1,1),auxmat(1,1))
9522 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9523 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9524 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9525 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9526 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9527 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9528 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9529 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9530 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9531 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9532 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9533 call transpose2(AEA(1,1,2),auxmat(1,1))
9534 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
9535 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
9536 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
9537 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9538 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
9539 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
9540 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
9541 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
9542 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
9543 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
9544 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
9545 C Calculate the Cartesian derivatives of the vectors.
9549 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9550 call matvec2(auxmat(1,1),b1(1,i),
9551 & AEAb1derx(1,lll,kkk,iii,1,1))
9552 call matvec2(auxmat(1,1),Ub2(1,i),
9553 & AEAb2derx(1,lll,kkk,iii,1,1))
9554 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9555 & AEAb1derx(1,lll,kkk,iii,2,1))
9556 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9557 & AEAb2derx(1,lll,kkk,iii,2,1))
9558 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9559 call matvec2(auxmat(1,1),b1(1,j),
9560 & AEAb1derx(1,lll,kkk,iii,1,2))
9561 call matvec2(auxmat(1,1),Ub2(1,j),
9562 & AEAb2derx(1,lll,kkk,iii,1,2))
9563 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9564 & AEAb1derx(1,lll,kkk,iii,2,2))
9565 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
9566 & AEAb2derx(1,lll,kkk,iii,2,2))
9573 C Antiparallel orientation of the two CA-CA-CA frames.
9575 iti=itype2loc(itype(i))
9579 itk1=itype2loc(itype(k+1))
9580 itl=itype2loc(itype(l))
9581 itj=itype2loc(itype(j))
9582 if (j.lt.nres-1) then
9583 itj1=itype2loc(itype(j+1))
9587 C A2 kernel(j-1)T A1T
9588 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9589 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
9590 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9591 C Following matrices are needed only for 6-th order cumulants
9592 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9593 & j.eq.i+4 .and. l.eq.i+3)) THEN
9594 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9595 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
9596 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9597 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9598 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
9599 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9600 & ADtEAderx(1,1,1,1,1,1))
9601 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9602 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
9603 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9604 & ADtEA1derx(1,1,1,1,1,1))
9606 C End 6-th order cumulants
9607 call transpose2(EUgder(1,1,k),auxmat(1,1))
9608 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9609 call transpose2(EUg(1,1,k),auxmat(1,1))
9610 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9611 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9615 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9616 & EAEAderx(1,1,lll,kkk,iii,1))
9620 C A2T kernel(i+1)T A1
9621 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9622 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
9623 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9624 C Following matrices are needed only for 6-th order cumulants
9625 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9626 & j.eq.i+4 .and. l.eq.i+3)) THEN
9627 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9628 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
9629 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9630 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9631 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
9632 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9633 & ADtEAderx(1,1,1,1,1,2))
9634 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9635 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
9636 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9637 & ADtEA1derx(1,1,1,1,1,2))
9639 C End 6-th order cumulants
9640 call transpose2(EUgder(1,1,j),auxmat(1,1))
9641 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9642 call transpose2(EUg(1,1,j),auxmat(1,1))
9643 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9644 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9648 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9649 & EAEAderx(1,1,lll,kkk,iii,2))
9654 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9655 C They are needed only when the fifth- or the sixth-order cumulants are
9657 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
9658 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9659 call transpose2(AEA(1,1,1),auxmat(1,1))
9660 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9661 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9662 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9663 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9664 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9665 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9666 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9667 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9668 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9669 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9670 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9671 call transpose2(AEA(1,1,2),auxmat(1,1))
9672 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
9673 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9674 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9675 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9676 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
9677 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9678 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
9679 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
9680 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9681 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9682 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9683 C Calculate the Cartesian derivatives of the vectors.
9687 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9688 call matvec2(auxmat(1,1),b1(1,i),
9689 & AEAb1derx(1,lll,kkk,iii,1,1))
9690 call matvec2(auxmat(1,1),Ub2(1,i),
9691 & AEAb2derx(1,lll,kkk,iii,1,1))
9692 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9693 & AEAb1derx(1,lll,kkk,iii,2,1))
9694 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9695 & AEAb2derx(1,lll,kkk,iii,2,1))
9696 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9697 call matvec2(auxmat(1,1),b1(1,l),
9698 & AEAb1derx(1,lll,kkk,iii,1,2))
9699 call matvec2(auxmat(1,1),Ub2(1,l),
9700 & AEAb2derx(1,lll,kkk,iii,1,2))
9701 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
9702 & AEAb1derx(1,lll,kkk,iii,2,2))
9703 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
9704 & AEAb2derx(1,lll,kkk,iii,2,2))
9713 C---------------------------------------------------------------------------
9714 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
9715 & KK,KKderg,AKA,AKAderg,AKAderx)
9719 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
9720 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
9721 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
9726 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9728 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
9731 cd if (lprn) write (2,*) 'In kernel'
9733 cd if (lprn) write (2,*) 'kkk=',kkk
9735 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
9736 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9738 cd write (2,*) 'lll=',lll
9739 cd write (2,*) 'iii=1'
9741 cd write (2,'(3(2f10.5),5x)')
9742 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9745 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
9746 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9748 cd write (2,*) 'lll=',lll
9749 cd write (2,*) 'iii=2'
9751 cd write (2,'(3(2f10.5),5x)')
9752 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9759 C---------------------------------------------------------------------------
9760 double precision function eello4(i,j,k,l,jj,kk)
9761 implicit real*8 (a-h,o-z)
9762 include 'DIMENSIONS'
9763 include 'COMMON.IOUNITS'
9764 include 'COMMON.CHAIN'
9765 include 'COMMON.DERIV'
9766 include 'COMMON.INTERACT'
9767 include 'COMMON.CONTACTS'
9768 include 'COMMON.TORSION'
9769 include 'COMMON.VAR'
9770 include 'COMMON.GEO'
9771 double precision pizda(2,2),ggg1(3),ggg2(3)
9772 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9776 cd print *,'eello4:',i,j,k,l,jj,kk
9777 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9778 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9779 cold eij=facont_hb(jj,i)
9780 cold ekl=facont_hb(kk,k)
9782 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9783 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9784 gcorr_loc(k-1)=gcorr_loc(k-1)
9785 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9787 gcorr_loc(l-1)=gcorr_loc(l-1)
9788 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9790 gcorr_loc(j-1)=gcorr_loc(j-1)
9791 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9796 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9797 & -EAEAderx(2,2,lll,kkk,iii,1)
9798 cd derx(lll,kkk,iii)=0.0d0
9802 cd gcorr_loc(l-1)=0.0d0
9803 cd gcorr_loc(j-1)=0.0d0
9804 cd gcorr_loc(k-1)=0.0d0
9806 cd write (iout,*)'Contacts have occurred for peptide groups',
9807 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9808 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9809 if (j.lt.nres-1) then
9816 if (l.lt.nres-1) then
9824 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9825 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9826 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9827 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9828 cgrad ghalf=0.5d0*ggg1(ll)
9829 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9830 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9831 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9832 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9833 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9834 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9835 cgrad ghalf=0.5d0*ggg2(ll)
9836 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9837 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9838 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9839 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9840 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9841 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9845 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9850 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9855 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9860 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9864 cd write (2,*) iii,gcorr_loc(iii)
9867 cd write (2,*) 'ekont',ekont
9868 cd write (iout,*) 'eello4',ekont*eel4
9871 C---------------------------------------------------------------------------
9872 double precision function eello5(i,j,k,l,jj,kk)
9873 implicit real*8 (a-h,o-z)
9874 include 'DIMENSIONS'
9875 include 'COMMON.IOUNITS'
9876 include 'COMMON.CHAIN'
9877 include 'COMMON.DERIV'
9878 include 'COMMON.INTERACT'
9879 include 'COMMON.CONTACTS'
9880 include 'COMMON.TORSION'
9881 include 'COMMON.VAR'
9882 include 'COMMON.GEO'
9883 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9884 double precision ggg1(3),ggg2(3)
9885 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9890 C /l\ / \ \ / \ / \ / C
9891 C / \ / \ \ / \ / \ / C
9892 C j| o |l1 | o | o| o | | o |o C
9893 C \ |/k\| |/ \| / |/ \| |/ \| C
9894 C \i/ \ / \ / / \ / \ C
9896 C (I) (II) (III) (IV) C
9898 C eello5_1 eello5_2 eello5_3 eello5_4 C
9900 C Antiparallel chains C
9903 C /j\ / \ \ / \ / \ / C
9904 C / \ / \ \ / \ / \ / C
9905 C j1| o |l | o | o| o | | o |o C
9906 C \ |/k\| |/ \| / |/ \| |/ \| C
9907 C \i/ \ / \ / / \ / \ C
9909 C (I) (II) (III) (IV) C
9911 C eello5_1 eello5_2 eello5_3 eello5_4 C
9913 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9915 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9916 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9921 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9923 itk=itype2loc(itype(k))
9924 itl=itype2loc(itype(l))
9925 itj=itype2loc(itype(j))
9930 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9931 cd & eel5_3_num,eel5_4_num)
9935 derx(lll,kkk,iii)=0.0d0
9939 cd eij=facont_hb(jj,i)
9940 cd ekl=facont_hb(kk,k)
9942 cd write (iout,*)'Contacts have occurred for peptide groups',
9943 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9945 C Contribution from the graph I.
9946 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9947 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9948 call transpose2(EUg(1,1,k),auxmat(1,1))
9949 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9950 vv(1)=pizda(1,1)-pizda(2,2)
9951 vv(2)=pizda(1,2)+pizda(2,1)
9952 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9953 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9954 C Explicit gradient in virtual-dihedral angles.
9955 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9956 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9957 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9958 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9959 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9960 vv(1)=pizda(1,1)-pizda(2,2)
9961 vv(2)=pizda(1,2)+pizda(2,1)
9962 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9963 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9964 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9965 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9966 vv(1)=pizda(1,1)-pizda(2,2)
9967 vv(2)=pizda(1,2)+pizda(2,1)
9969 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9970 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9971 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9973 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9974 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9975 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9977 C Cartesian gradient
9981 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
9983 vv(1)=pizda(1,1)-pizda(2,2)
9984 vv(2)=pizda(1,2)+pizda(2,1)
9985 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9986 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
9987 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9993 C Contribution from graph II
9994 call transpose2(EE(1,1,k),auxmat(1,1))
9995 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9996 vv(1)=pizda(1,1)+pizda(2,2)
9997 vv(2)=pizda(2,1)-pizda(1,2)
9998 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
9999 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
10000 C Explicit gradient in virtual-dihedral angles.
10001 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10002 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
10003 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
10004 vv(1)=pizda(1,1)+pizda(2,2)
10005 vv(2)=pizda(2,1)-pizda(1,2)
10007 g_corr5_loc(l-1)=g_corr5_loc(l-1)
10008 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
10009 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
10011 g_corr5_loc(j-1)=g_corr5_loc(j-1)
10012 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
10013 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
10015 C Cartesian gradient
10019 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
10021 vv(1)=pizda(1,1)+pizda(2,2)
10022 vv(2)=pizda(2,1)-pizda(1,2)
10023 derx(lll,kkk,iii)=derx(lll,kkk,iii)
10024 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
10025 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
10033 C Parallel orientation
10034 C Contribution from graph III
10035 call transpose2(EUg(1,1,l),auxmat(1,1))
10036 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
10037 vv(1)=pizda(1,1)-pizda(2,2)
10038 vv(2)=pizda(1,2)+pizda(2,1)
10039 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
10040 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
10041 C Explicit gradient in virtual-dihedral angles.
10042 g_corr5_loc(j-1)=g_corr5_loc(j-1)
10043 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
10044 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
10045 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
10046 vv(1)=pizda(1,1)-pizda(2,2)
10047 vv(2)=pizda(1,2)+pizda(2,1)
10048 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10049 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
10050 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
10051 call transpose2(EUgder(1,1,l),auxmat1(1,1))
10052 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
10053 vv(1)=pizda(1,1)-pizda(2,2)
10054 vv(2)=pizda(1,2)+pizda(2,1)
10055 g_corr5_loc(l-1)=g_corr5_loc(l-1)
10056 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
10057 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
10058 C Cartesian gradient
10062 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
10064 vv(1)=pizda(1,1)-pizda(2,2)
10065 vv(2)=pizda(1,2)+pizda(2,1)
10066 derx(lll,kkk,iii)=derx(lll,kkk,iii)
10067 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
10068 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
10073 C Contribution from graph IV
10075 call transpose2(EE(1,1,l),auxmat(1,1))
10076 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
10077 vv(1)=pizda(1,1)+pizda(2,2)
10078 vv(2)=pizda(2,1)-pizda(1,2)
10079 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
10080 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
10081 C Explicit gradient in virtual-dihedral angles.
10082 g_corr5_loc(l-1)=g_corr5_loc(l-1)
10083 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
10084 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
10085 vv(1)=pizda(1,1)+pizda(2,2)
10086 vv(2)=pizda(2,1)-pizda(1,2)
10087 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10088 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
10089 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
10090 C Cartesian gradient
10094 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
10096 vv(1)=pizda(1,1)+pizda(2,2)
10097 vv(2)=pizda(2,1)-pizda(1,2)
10098 derx(lll,kkk,iii)=derx(lll,kkk,iii)
10099 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
10100 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
10105 C Antiparallel orientation
10106 C Contribution from graph III
10108 call transpose2(EUg(1,1,j),auxmat(1,1))
10109 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
10110 vv(1)=pizda(1,1)-pizda(2,2)
10111 vv(2)=pizda(1,2)+pizda(2,1)
10112 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
10113 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
10114 C Explicit gradient in virtual-dihedral angles.
10115 g_corr5_loc(l-1)=g_corr5_loc(l-1)
10116 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
10117 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
10118 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
10119 vv(1)=pizda(1,1)-pizda(2,2)
10120 vv(2)=pizda(1,2)+pizda(2,1)
10121 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10122 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
10123 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
10124 call transpose2(EUgder(1,1,j),auxmat1(1,1))
10125 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
10126 vv(1)=pizda(1,1)-pizda(2,2)
10127 vv(2)=pizda(1,2)+pizda(2,1)
10128 g_corr5_loc(j-1)=g_corr5_loc(j-1)
10129 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
10130 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
10131 C Cartesian gradient
10135 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
10137 vv(1)=pizda(1,1)-pizda(2,2)
10138 vv(2)=pizda(1,2)+pizda(2,1)
10139 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
10140 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
10141 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
10146 C Contribution from graph IV
10148 call transpose2(EE(1,1,j),auxmat(1,1))
10149 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
10150 vv(1)=pizda(1,1)+pizda(2,2)
10151 vv(2)=pizda(2,1)-pizda(1,2)
10152 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
10153 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
10154 C Explicit gradient in virtual-dihedral angles.
10155 g_corr5_loc(j-1)=g_corr5_loc(j-1)
10156 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
10157 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
10158 vv(1)=pizda(1,1)+pizda(2,2)
10159 vv(2)=pizda(2,1)-pizda(1,2)
10160 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10161 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
10162 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
10163 C Cartesian gradient
10167 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
10169 vv(1)=pizda(1,1)+pizda(2,2)
10170 vv(2)=pizda(2,1)-pizda(1,2)
10171 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
10172 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
10173 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
10179 eel5=eello5_1+eello5_2+eello5_3+eello5_4
10180 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
10181 cd write (2,*) 'ijkl',i,j,k,l
10182 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
10183 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
10185 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
10186 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
10187 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
10188 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
10189 if (j.lt.nres-1) then
10196 if (l.lt.nres-1) then
10206 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
10207 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
10208 C summed up outside the subrouine as for the other subroutines
10209 C handling long-range interactions. The old code is commented out
10210 C with "cgrad" to keep track of changes.
10212 cgrad ggg1(ll)=eel5*g_contij(ll,1)
10213 cgrad ggg2(ll)=eel5*g_contij(ll,2)
10214 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
10215 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
10216 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
10217 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
10218 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
10219 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
10220 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
10221 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
10223 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
10224 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
10225 cgrad ghalf=0.5d0*ggg1(ll)
10227 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
10228 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
10229 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
10230 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
10231 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
10232 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
10233 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
10234 cgrad ghalf=0.5d0*ggg2(ll)
10236 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
10237 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
10238 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
10239 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
10240 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
10241 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
10246 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
10247 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
10252 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
10253 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
10259 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
10264 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
10268 cd write (2,*) iii,g_corr5_loc(iii)
10271 cd write (2,*) 'ekont',ekont
10272 cd write (iout,*) 'eello5',ekont*eel5
10275 c--------------------------------------------------------------------------
10276 double precision function eello6(i,j,k,l,jj,kk)
10277 implicit real*8 (a-h,o-z)
10278 include 'DIMENSIONS'
10279 include 'COMMON.IOUNITS'
10280 include 'COMMON.CHAIN'
10281 include 'COMMON.DERIV'
10282 include 'COMMON.INTERACT'
10283 include 'COMMON.CONTACTS'
10284 include 'COMMON.TORSION'
10285 include 'COMMON.VAR'
10286 include 'COMMON.GEO'
10287 include 'COMMON.FFIELD'
10288 double precision ggg1(3),ggg2(3)
10289 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10294 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10302 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
10303 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
10307 derx(lll,kkk,iii)=0.0d0
10311 cd eij=facont_hb(jj,i)
10312 cd ekl=facont_hb(kk,k)
10318 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
10319 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
10320 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
10321 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
10322 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
10323 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
10325 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
10326 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
10327 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
10328 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
10329 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
10330 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10334 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
10336 C If turn contributions are considered, they will be handled separately.
10337 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
10338 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
10339 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
10340 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
10341 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
10342 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
10343 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
10345 if (j.lt.nres-1) then
10352 if (l.lt.nres-1) then
10360 cgrad ggg1(ll)=eel6*g_contij(ll,1)
10361 cgrad ggg2(ll)=eel6*g_contij(ll,2)
10362 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
10363 cgrad ghalf=0.5d0*ggg1(ll)
10365 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
10366 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
10367 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
10368 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
10369 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
10370 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
10371 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
10372 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
10373 cgrad ghalf=0.5d0*ggg2(ll)
10374 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
10376 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
10377 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
10378 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
10379 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
10380 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
10381 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
10386 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
10387 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
10392 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
10393 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
10399 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
10404 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
10408 cd write (2,*) iii,g_corr6_loc(iii)
10411 cd write (2,*) 'ekont',ekont
10412 cd write (iout,*) 'eello6',ekont*eel6
10415 c--------------------------------------------------------------------------
10416 double precision function eello6_graph1(i,j,k,l,imat,swap)
10417 implicit real*8 (a-h,o-z)
10418 include 'DIMENSIONS'
10419 include 'COMMON.IOUNITS'
10420 include 'COMMON.CHAIN'
10421 include 'COMMON.DERIV'
10422 include 'COMMON.INTERACT'
10423 include 'COMMON.CONTACTS'
10424 include 'COMMON.TORSION'
10425 include 'COMMON.VAR'
10426 include 'COMMON.GEO'
10427 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
10430 common /kutas/ lprn
10431 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10433 C Parallel Antiparallel C
10439 C \ j|/k\| / \ |/k\|l / C
10440 C \ / \ / \ / \ / C
10444 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10445 itk=itype2loc(itype(k))
10446 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
10447 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
10448 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
10449 call transpose2(EUgC(1,1,k),auxmat(1,1))
10450 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10451 vv1(1)=pizda1(1,1)-pizda1(2,2)
10452 vv1(2)=pizda1(1,2)+pizda1(2,1)
10453 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10454 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
10455 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
10456 s5=scalar2(vv(1),Dtobr2(1,i))
10457 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
10458 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
10459 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
10460 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
10461 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
10462 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
10463 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
10464 & +scalar2(vv(1),Dtobr2der(1,i)))
10465 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
10466 vv1(1)=pizda1(1,1)-pizda1(2,2)
10467 vv1(2)=pizda1(1,2)+pizda1(2,1)
10468 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
10469 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
10471 g_corr6_loc(l-1)=g_corr6_loc(l-1)
10472 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
10473 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
10474 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
10475 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10477 g_corr6_loc(j-1)=g_corr6_loc(j-1)
10478 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
10479 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
10480 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
10481 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10483 call transpose2(EUgCder(1,1,k),auxmat(1,1))
10484 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10485 vv1(1)=pizda1(1,1)-pizda1(2,2)
10486 vv1(2)=pizda1(1,2)+pizda1(2,1)
10487 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
10488 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
10489 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
10490 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
10499 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
10500 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
10501 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
10502 call transpose2(EUgC(1,1,k),auxmat(1,1))
10503 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10505 vv1(1)=pizda1(1,1)-pizda1(2,2)
10506 vv1(2)=pizda1(1,2)+pizda1(2,1)
10507 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10508 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
10509 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
10510 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
10511 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
10512 s5=scalar2(vv(1),Dtobr2(1,i))
10513 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
10519 c----------------------------------------------------------------------------
10520 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
10521 implicit real*8 (a-h,o-z)
10522 include 'DIMENSIONS'
10523 include 'COMMON.IOUNITS'
10524 include 'COMMON.CHAIN'
10525 include 'COMMON.DERIV'
10526 include 'COMMON.INTERACT'
10527 include 'COMMON.CONTACTS'
10528 include 'COMMON.TORSION'
10529 include 'COMMON.VAR'
10530 include 'COMMON.GEO'
10532 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10533 & auxvec1(2),auxvec2(2),auxmat1(2,2)
10535 common /kutas/ lprn
10536 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10538 C Parallel Antiparallel C
10544 C \ j|/k\| \ |/k\|l C
10549 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10550 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
10551 C AL 7/4/01 s1 would occur in the sixth-order moment,
10552 C but not in a cluster cumulant
10554 s1=dip(1,jj,i)*dip(1,kk,k)
10556 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
10557 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10558 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
10559 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
10560 call transpose2(EUg(1,1,k),auxmat(1,1))
10561 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
10562 vv(1)=pizda(1,1)-pizda(2,2)
10563 vv(2)=pizda(1,2)+pizda(2,1)
10564 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10565 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10567 eello6_graph2=-(s1+s2+s3+s4)
10569 eello6_graph2=-(s2+s3+s4)
10571 c eello6_graph2=-s3
10572 C Derivatives in gamma(i-1)
10575 s1=dipderg(1,jj,i)*dip(1,kk,k)
10577 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10578 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
10579 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10580 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10582 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10584 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10586 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
10588 C Derivatives in gamma(k-1)
10590 s1=dip(1,jj,i)*dipderg(1,kk,k)
10592 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
10593 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10594 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
10595 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10596 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10597 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
10598 vv(1)=pizda(1,1)-pizda(2,2)
10599 vv(2)=pizda(1,2)+pizda(2,1)
10600 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10602 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10604 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10606 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
10607 C Derivatives in gamma(j-1) or gamma(l-1)
10610 s1=dipderg(3,jj,i)*dip(1,kk,k)
10612 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
10613 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10614 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
10615 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
10616 vv(1)=pizda(1,1)-pizda(2,2)
10617 vv(2)=pizda(1,2)+pizda(2,1)
10618 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10621 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10623 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10626 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10627 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10629 C Derivatives in gamma(l-1) or gamma(j-1)
10632 s1=dip(1,jj,i)*dipderg(3,kk,k)
10634 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10635 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10636 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10637 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10638 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10639 vv(1)=pizda(1,1)-pizda(2,2)
10640 vv(2)=pizda(1,2)+pizda(2,1)
10641 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10644 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10646 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10649 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10650 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10652 C Cartesian derivatives.
10654 write (2,*) 'In eello6_graph2'
10656 write (2,*) 'iii=',iii
10658 write (2,*) 'kkk=',kkk
10660 write (2,'(3(2f10.5),5x)')
10661 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10671 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10673 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10676 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
10678 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10679 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
10681 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10682 call transpose2(EUg(1,1,k),auxmat(1,1))
10683 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
10685 vv(1)=pizda(1,1)-pizda(2,2)
10686 vv(2)=pizda(1,2)+pizda(2,1)
10687 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10688 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10690 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10692 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10695 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10697 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10704 c----------------------------------------------------------------------------
10705 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
10706 implicit real*8 (a-h,o-z)
10707 include 'DIMENSIONS'
10708 include 'COMMON.IOUNITS'
10709 include 'COMMON.CHAIN'
10710 include 'COMMON.DERIV'
10711 include 'COMMON.INTERACT'
10712 include 'COMMON.CONTACTS'
10713 include 'COMMON.TORSION'
10714 include 'COMMON.VAR'
10715 include 'COMMON.GEO'
10716 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
10718 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10720 C Parallel Antiparallel C
10725 C /| o |o o| o |\ C
10726 C j|/k\| / |/k\|l / C
10731 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10733 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10734 C energy moment and not to the cluster cumulant.
10735 iti=itortyp(itype(i))
10736 if (j.lt.nres-1) then
10737 itj1=itype2loc(itype(j+1))
10741 itk=itype2loc(itype(k))
10742 itk1=itype2loc(itype(k+1))
10743 if (l.lt.nres-1) then
10744 itl1=itype2loc(itype(l+1))
10749 s1=dip(4,jj,i)*dip(4,kk,k)
10751 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
10752 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10753 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
10754 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10755 call transpose2(EE(1,1,k),auxmat(1,1))
10756 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10757 vv(1)=pizda(1,1)+pizda(2,2)
10758 vv(2)=pizda(2,1)-pizda(1,2)
10759 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10760 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10761 cd & "sum",-(s2+s3+s4)
10763 eello6_graph3=-(s1+s2+s3+s4)
10765 eello6_graph3=-(s2+s3+s4)
10767 c eello6_graph3=-s4
10768 C Derivatives in gamma(k-1)
10769 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
10770 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10771 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10772 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10773 C Derivatives in gamma(l-1)
10774 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
10775 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10776 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10777 vv(1)=pizda(1,1)+pizda(2,2)
10778 vv(2)=pizda(2,1)-pizda(1,2)
10779 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10780 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10781 C Cartesian derivatives.
10787 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10789 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10792 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
10794 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10795 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
10797 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10798 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
10800 vv(1)=pizda(1,1)+pizda(2,2)
10801 vv(2)=pizda(2,1)-pizda(1,2)
10802 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10804 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10806 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10809 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10811 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10813 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10819 c----------------------------------------------------------------------------
10820 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10821 implicit real*8 (a-h,o-z)
10822 include 'DIMENSIONS'
10823 include 'COMMON.IOUNITS'
10824 include 'COMMON.CHAIN'
10825 include 'COMMON.DERIV'
10826 include 'COMMON.INTERACT'
10827 include 'COMMON.CONTACTS'
10828 include 'COMMON.TORSION'
10829 include 'COMMON.VAR'
10830 include 'COMMON.GEO'
10831 include 'COMMON.FFIELD'
10832 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10833 & auxvec1(2),auxmat1(2,2)
10835 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10837 C Parallel Antiparallel C
10842 C /| o |o o| o |\ C
10843 C \ j|/k\| \ |/k\|l C
10848 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10850 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10851 C energy moment and not to the cluster cumulant.
10852 cd write (2,*) 'eello_graph4: wturn6',wturn6
10853 iti=itype2loc(itype(i))
10854 itj=itype2loc(itype(j))
10855 if (j.lt.nres-1) then
10856 itj1=itype2loc(itype(j+1))
10860 itk=itype2loc(itype(k))
10861 if (k.lt.nres-1) then
10862 itk1=itype2loc(itype(k+1))
10866 itl=itype2loc(itype(l))
10867 if (l.lt.nres-1) then
10868 itl1=itype2loc(itype(l+1))
10872 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10873 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10874 cd & ' itl',itl,' itl1',itl1
10876 if (imat.eq.1) then
10877 s1=dip(3,jj,i)*dip(3,kk,k)
10879 s1=dip(2,jj,j)*dip(2,kk,l)
10882 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10883 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10885 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
10886 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10888 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
10889 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10891 call transpose2(EUg(1,1,k),auxmat(1,1))
10892 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10893 vv(1)=pizda(1,1)-pizda(2,2)
10894 vv(2)=pizda(2,1)+pizda(1,2)
10895 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10896 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10898 eello6_graph4=-(s1+s2+s3+s4)
10900 eello6_graph4=-(s2+s3+s4)
10902 C Derivatives in gamma(i-1)
10905 if (imat.eq.1) then
10906 s1=dipderg(2,jj,i)*dip(3,kk,k)
10908 s1=dipderg(4,jj,j)*dip(2,kk,l)
10911 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10913 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
10914 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10916 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
10917 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10919 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10920 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10921 cd write (2,*) 'turn6 derivatives'
10923 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10925 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10929 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10931 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10935 C Derivatives in gamma(k-1)
10937 if (imat.eq.1) then
10938 s1=dip(3,jj,i)*dipderg(2,kk,k)
10940 s1=dip(2,jj,j)*dipderg(4,kk,l)
10943 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10944 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10946 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
10947 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10949 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
10950 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10952 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10953 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10954 vv(1)=pizda(1,1)-pizda(2,2)
10955 vv(2)=pizda(2,1)+pizda(1,2)
10956 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10957 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10959 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10961 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10965 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10967 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10970 C Derivatives in gamma(j-1) or gamma(l-1)
10971 if (l.eq.j+1 .and. l.gt.1) then
10972 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10973 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10974 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10975 vv(1)=pizda(1,1)-pizda(2,2)
10976 vv(2)=pizda(2,1)+pizda(1,2)
10977 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10978 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10979 else if (j.gt.1) then
10980 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10981 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10982 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10983 vv(1)=pizda(1,1)-pizda(2,2)
10984 vv(2)=pizda(2,1)+pizda(1,2)
10985 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10986 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10987 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10989 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10992 C Cartesian derivatives.
10998 if (imat.eq.1) then
10999 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
11001 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
11004 if (imat.eq.1) then
11005 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
11007 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
11011 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
11013 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
11015 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
11016 & b1(1,j+1),auxvec(1))
11017 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
11019 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
11020 & b1(1,l+1),auxvec(1))
11021 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
11023 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
11025 vv(1)=pizda(1,1)-pizda(2,2)
11026 vv(2)=pizda(2,1)+pizda(1,2)
11027 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
11029 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
11031 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
11034 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
11037 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
11040 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
11042 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
11044 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
11048 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
11050 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
11053 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
11055 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
11063 c----------------------------------------------------------------------------
11064 double precision function eello_turn6(i,jj,kk)
11065 implicit real*8 (a-h,o-z)
11066 include 'DIMENSIONS'
11067 include 'COMMON.IOUNITS'
11068 include 'COMMON.CHAIN'
11069 include 'COMMON.DERIV'
11070 include 'COMMON.INTERACT'
11071 include 'COMMON.CONTACTS'
11072 include 'COMMON.TORSION'
11073 include 'COMMON.VAR'
11074 include 'COMMON.GEO'
11075 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
11076 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
11078 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
11079 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
11080 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
11081 C the respective energy moment and not to the cluster cumulant.
11090 iti=itype2loc(itype(i))
11091 itk=itype2loc(itype(k))
11092 itk1=itype2loc(itype(k+1))
11093 itl=itype2loc(itype(l))
11094 itj=itype2loc(itype(j))
11095 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
11096 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
11097 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
11102 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
11104 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
11108 derx_turn(lll,kkk,iii)=0.0d0
11115 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
11117 cd write (2,*) 'eello6_5',eello6_5
11119 call transpose2(AEA(1,1,1),auxmat(1,1))
11120 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
11121 ss1=scalar2(Ub2(1,i+2),b1(1,l))
11122 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
11124 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
11125 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
11126 s2 = scalar2(b1(1,k),vtemp1(1))
11128 call transpose2(AEA(1,1,2),atemp(1,1))
11129 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
11130 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
11131 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
11133 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
11134 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
11135 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
11137 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
11138 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
11139 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
11140 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
11141 ss13 = scalar2(b1(1,k),vtemp4(1))
11142 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
11144 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
11150 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
11151 C Derivatives in gamma(i+2)
11155 call transpose2(AEA(1,1,1),auxmatd(1,1))
11156 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
11157 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
11158 call transpose2(AEAderg(1,1,2),atempd(1,1))
11159 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
11160 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
11162 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
11163 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
11164 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
11170 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
11171 C Derivatives in gamma(i+3)
11173 call transpose2(AEA(1,1,1),auxmatd(1,1))
11174 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
11175 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
11176 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
11178 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
11179 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
11180 s2d = scalar2(b1(1,k),vtemp1d(1))
11182 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
11183 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
11185 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
11187 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
11188 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
11189 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
11197 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
11198 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
11200 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
11201 & -0.5d0*ekont*(s2d+s12d)
11203 C Derivatives in gamma(i+4)
11204 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
11205 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
11206 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
11208 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
11209 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
11210 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
11218 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
11220 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
11222 C Derivatives in gamma(i+5)
11224 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
11225 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
11226 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
11228 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
11229 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
11230 s2d = scalar2(b1(1,k),vtemp1d(1))
11232 call transpose2(AEA(1,1,2),atempd(1,1))
11233 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
11234 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
11236 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
11237 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
11239 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
11240 ss13d = scalar2(b1(1,k),vtemp4d(1))
11241 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
11249 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
11250 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
11252 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
11253 & -0.5d0*ekont*(s2d+s12d)
11255 C Cartesian derivatives
11260 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
11261 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
11262 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
11264 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
11265 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
11267 s2d = scalar2(b1(1,k),vtemp1d(1))
11269 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
11270 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
11271 s8d = -(atempd(1,1)+atempd(2,2))*
11272 & scalar2(cc(1,1,itl),vtemp2(1))
11274 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
11276 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
11277 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
11284 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
11285 & - 0.5d0*(s1d+s2d)
11287 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
11291 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
11292 & - 0.5d0*(s8d+s12d)
11294 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
11303 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
11304 & achuj_tempd(1,1))
11305 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
11306 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
11307 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
11308 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
11309 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
11311 ss13d = scalar2(b1(1,k),vtemp4d(1))
11312 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
11313 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
11317 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
11318 cd & 16*eel_turn6_num
11320 if (j.lt.nres-1) then
11327 if (l.lt.nres-1) then
11335 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
11336 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
11337 cgrad ghalf=0.5d0*ggg1(ll)
11339 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
11340 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
11341 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
11342 & +ekont*derx_turn(ll,2,1)
11343 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
11344 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
11345 & +ekont*derx_turn(ll,4,1)
11346 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
11347 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
11348 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
11349 cgrad ghalf=0.5d0*ggg2(ll)
11351 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
11352 & +ekont*derx_turn(ll,2,2)
11353 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
11354 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
11355 & +ekont*derx_turn(ll,4,2)
11356 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
11357 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
11358 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
11363 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
11368 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
11374 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
11379 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
11383 cd write (2,*) iii,g_corr6_loc(iii)
11385 eello_turn6=ekont*eel_turn6
11386 cd write (2,*) 'ekont',ekont
11387 cd write (2,*) 'eel_turn6',ekont*eel_turn6
11391 C-----------------------------------------------------------------------------
11392 double precision function scalar(u,v)
11393 !DIR$ INLINEALWAYS scalar
11395 cDEC$ ATTRIBUTES FORCEINLINE::scalar
11398 double precision u(3),v(3)
11399 cd double precision sc
11407 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
11410 crc-------------------------------------------------
11411 SUBROUTINE MATVEC2(A1,V1,V2)
11412 !DIR$ INLINEALWAYS MATVEC2
11414 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
11416 implicit real*8 (a-h,o-z)
11417 include 'DIMENSIONS'
11418 DIMENSION A1(2,2),V1(2),V2(2)
11422 c 3 VI=VI+A1(I,K)*V1(K)
11426 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
11427 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
11432 C---------------------------------------
11433 SUBROUTINE MATMAT2(A1,A2,A3)
11435 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
11437 implicit real*8 (a-h,o-z)
11438 include 'DIMENSIONS'
11439 DIMENSION A1(2,2),A2(2,2),A3(2,2)
11440 c DIMENSION AI3(2,2)
11444 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
11450 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
11451 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
11452 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
11453 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
11461 c-------------------------------------------------------------------------
11462 double precision function scalar2(u,v)
11463 !DIR$ INLINEALWAYS scalar2
11465 double precision u(2),v(2)
11466 double precision sc
11468 scalar2=u(1)*v(1)+u(2)*v(2)
11472 C-----------------------------------------------------------------------------
11474 subroutine transpose2(a,at)
11475 !DIR$ INLINEALWAYS transpose2
11477 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
11480 double precision a(2,2),at(2,2)
11487 c--------------------------------------------------------------------------
11488 subroutine transpose(n,a,at)
11491 double precision a(n,n),at(n,n)
11499 C---------------------------------------------------------------------------
11500 subroutine prodmat3(a1,a2,kk,transp,prod)
11501 !DIR$ INLINEALWAYS prodmat3
11503 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
11507 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
11509 crc double precision auxmat(2,2),prod_(2,2)
11512 crc call transpose2(kk(1,1),auxmat(1,1))
11513 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
11514 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11516 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
11517 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
11518 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
11519 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
11520 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
11521 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
11522 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
11523 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
11526 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
11527 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11529 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
11530 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
11531 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
11532 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
11533 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
11534 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
11535 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
11536 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
11539 c call transpose2(a2(1,1),a2t(1,1))
11542 crc print *,((prod_(i,j),i=1,2),j=1,2)
11543 crc print *,((prod(i,j),i=1,2),j=1,2)
11547 CCC----------------------------------------------
11548 subroutine Eliptransfer(eliptran)
11549 implicit real*8 (a-h,o-z)
11550 include 'DIMENSIONS'
11551 include 'COMMON.GEO'
11552 include 'COMMON.VAR'
11553 include 'COMMON.LOCAL'
11554 include 'COMMON.CHAIN'
11555 include 'COMMON.DERIV'
11556 include 'COMMON.NAMES'
11557 include 'COMMON.INTERACT'
11558 include 'COMMON.IOUNITS'
11559 include 'COMMON.CALC'
11560 include 'COMMON.CONTROL'
11561 include 'COMMON.SPLITELE'
11562 include 'COMMON.SBRIDGE'
11563 C this is done by Adasko
11564 C print *,"wchodze"
11565 C structure of box:
11567 C--bordliptop-- buffore starts
11568 C--bufliptop--- here true lipid starts
11570 C--buflipbot--- lipid ends buffore starts
11571 C--bordlipbot--buffore ends
11573 do i=ilip_start,ilip_end
11575 if (itype(i).eq.ntyp1) cycle
11577 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
11578 if (positi.le.0.0) positi=positi+boxzsize
11580 C first for peptide groups
11581 c for each residue check if it is in lipid or lipid water border area
11582 if ((positi.gt.bordlipbot)
11583 &.and.(positi.lt.bordliptop)) then
11584 C the energy transfer exist
11585 if (positi.lt.buflipbot) then
11586 C what fraction I am in
11588 & ((positi-bordlipbot)/lipbufthick)
11589 C lipbufthick is thickenes of lipid buffore
11590 sslip=sscalelip(fracinbuf)
11591 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11592 eliptran=eliptran+sslip*pepliptran
11593 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11594 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11595 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11597 C print *,"doing sccale for lower part"
11598 C print *,i,sslip,fracinbuf,ssgradlip
11599 elseif (positi.gt.bufliptop) then
11600 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
11601 sslip=sscalelip(fracinbuf)
11602 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11603 eliptran=eliptran+sslip*pepliptran
11604 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11605 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11606 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11607 C print *, "doing sscalefor top part"
11608 C print *,i,sslip,fracinbuf,ssgradlip
11610 eliptran=eliptran+pepliptran
11611 C print *,"I am in true lipid"
11614 C eliptran=elpitran+0.0 ! I am in water
11617 C print *, "nic nie bylo w lipidzie?"
11618 C now multiply all by the peptide group transfer factor
11619 C eliptran=eliptran*pepliptran
11620 C now the same for side chains
11622 do i=ilip_start,ilip_end
11623 if (itype(i).eq.ntyp1) cycle
11624 positi=(mod(c(3,i+nres),boxzsize))
11625 if (positi.le.0) positi=positi+boxzsize
11626 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
11627 c for each residue check if it is in lipid or lipid water border area
11628 C respos=mod(c(3,i+nres),boxzsize)
11629 C print *,positi,bordlipbot,buflipbot
11630 if ((positi.gt.bordlipbot)
11631 & .and.(positi.lt.bordliptop)) then
11632 C the energy transfer exist
11633 if (positi.lt.buflipbot) then
11635 & ((positi-bordlipbot)/lipbufthick)
11636 C lipbufthick is thickenes of lipid buffore
11637 sslip=sscalelip(fracinbuf)
11638 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11639 eliptran=eliptran+sslip*liptranene(itype(i))
11640 gliptranx(3,i)=gliptranx(3,i)
11641 &+ssgradlip*liptranene(itype(i))
11642 gliptranc(3,i-1)= gliptranc(3,i-1)
11643 &+ssgradlip*liptranene(itype(i))
11644 C print *,"doing sccale for lower part"
11645 elseif (positi.gt.bufliptop) then
11647 &((bordliptop-positi)/lipbufthick)
11648 sslip=sscalelip(fracinbuf)
11649 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11650 eliptran=eliptran+sslip*liptranene(itype(i))
11651 gliptranx(3,i)=gliptranx(3,i)
11652 &+ssgradlip*liptranene(itype(i))
11653 gliptranc(3,i-1)= gliptranc(3,i-1)
11654 &+ssgradlip*liptranene(itype(i))
11655 C print *, "doing sscalefor top part",sslip,fracinbuf
11657 eliptran=eliptran+liptranene(itype(i))
11658 C print *,"I am in true lipid"
11660 endif ! if in lipid or buffor
11662 C eliptran=elpitran+0.0 ! I am in water
11666 C---------------------------------------------------------
11667 C AFM soubroutine for constant force
11668 subroutine AFMforce(Eafmforce)
11669 implicit real*8 (a-h,o-z)
11670 include 'DIMENSIONS'
11671 include 'COMMON.GEO'
11672 include 'COMMON.VAR'
11673 include 'COMMON.LOCAL'
11674 include 'COMMON.CHAIN'
11675 include 'COMMON.DERIV'
11676 include 'COMMON.NAMES'
11677 include 'COMMON.INTERACT'
11678 include 'COMMON.IOUNITS'
11679 include 'COMMON.CALC'
11680 include 'COMMON.CONTROL'
11681 include 'COMMON.SPLITELE'
11682 include 'COMMON.SBRIDGE'
11687 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11688 dist=dist+diffafm(i)**2
11691 Eafmforce=-forceAFMconst*(dist-distafminit)
11693 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
11694 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
11696 C print *,'AFM',Eafmforce
11699 C---------------------------------------------------------
11700 C AFM subroutine with pseudoconstant velocity
11701 subroutine AFMvel(Eafmforce)
11702 implicit real*8 (a-h,o-z)
11703 include 'DIMENSIONS'
11704 include 'COMMON.GEO'
11705 include 'COMMON.VAR'
11706 include 'COMMON.LOCAL'
11707 include 'COMMON.CHAIN'
11708 include 'COMMON.DERIV'
11709 include 'COMMON.NAMES'
11710 include 'COMMON.INTERACT'
11711 include 'COMMON.IOUNITS'
11712 include 'COMMON.CALC'
11713 include 'COMMON.CONTROL'
11714 include 'COMMON.SPLITELE'
11715 include 'COMMON.SBRIDGE'
11717 C Only for check grad COMMENT if not used for checkgrad
11719 C--------------------------------------------------------
11720 C print *,"wchodze"
11724 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11725 dist=dist+diffafm(i)**2
11728 Eafmforce=0.5d0*forceAFMconst
11729 & *(distafminit+totTafm*velAFMconst-dist)**2
11730 C Eafmforce=-forceAFMconst*(dist-distafminit)
11732 gradafm(i,afmend-1)=-forceAFMconst*
11733 &(distafminit+totTafm*velAFMconst-dist)
11735 gradafm(i,afmbeg-1)=forceAFMconst*
11736 &(distafminit+totTafm*velAFMconst-dist)
11739 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
11742 C-----------------------------------------------------------
11743 C first for shielding is setting of function of side-chains
11744 subroutine set_shield_fac
11745 implicit real*8 (a-h,o-z)
11746 include 'DIMENSIONS'
11747 include 'COMMON.CHAIN'
11748 include 'COMMON.DERIV'
11749 include 'COMMON.IOUNITS'
11750 include 'COMMON.SHIELD'
11751 include 'COMMON.INTERACT'
11752 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11753 double precision div77_81/0.974996043d0/,
11754 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11756 C the vector between center of side_chain and peptide group
11757 double precision pep_side(3),long,side_calf(3),
11758 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11759 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11760 C the line belowe needs to be changed for FGPROC>1
11762 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11764 Cif there two consequtive dummy atoms there is no peptide group between them
11765 C the line below has to be changed for FGPROC>1
11768 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11772 C first lets set vector conecting the ithe side-chain with kth side-chain
11773 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11774 C pep_side(j)=2.0d0
11775 C and vector conecting the side-chain with its proper calfa
11776 side_calf(j)=c(j,k+nres)-c(j,k)
11777 C side_calf(j)=2.0d0
11778 pept_group(j)=c(j,i)-c(j,i+1)
11779 C lets have their lenght
11780 dist_pep_side=pep_side(j)**2+dist_pep_side
11781 dist_side_calf=dist_side_calf+side_calf(j)**2
11782 dist_pept_group=dist_pept_group+pept_group(j)**2
11784 dist_pep_side=dsqrt(dist_pep_side)
11785 dist_pept_group=dsqrt(dist_pept_group)
11786 dist_side_calf=dsqrt(dist_side_calf)
11788 pep_side_norm(j)=pep_side(j)/dist_pep_side
11789 side_calf_norm(j)=dist_side_calf
11791 C now sscale fraction
11792 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
11793 C print *,buff_shield,"buff"
11795 if (sh_frac_dist.le.0.0) cycle
11796 C If we reach here it means that this side chain reaches the shielding sphere
11797 C Lets add him to the list for gradient
11798 ishield_list(i)=ishield_list(i)+1
11799 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
11800 C this list is essential otherwise problem would be O3
11801 shield_list(ishield_list(i),i)=k
11802 C Lets have the sscale value
11803 if (sh_frac_dist.gt.1.0) then
11804 scale_fac_dist=1.0d0
11806 sh_frac_dist_grad(j)=0.0d0
11809 scale_fac_dist=-sh_frac_dist*sh_frac_dist
11810 & *(2.0*sh_frac_dist-3.0d0)
11811 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
11812 & /dist_pep_side/buff_shield*0.5
11813 C remember for the final gradient multiply sh_frac_dist_grad(j)
11814 C for side_chain by factor -2 !
11816 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
11817 C print *,"jestem",scale_fac_dist,fac_help_scale,
11818 C & sh_frac_dist_grad(j)
11821 C if ((i.eq.3).and.(k.eq.2)) then
11822 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
11826 C this is what is now we have the distance scaling now volume...
11827 short=short_r_sidechain(itype(k))
11828 long=long_r_sidechain(itype(k))
11829 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
11832 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
11833 C costhet_fac=0.0d0
11835 costhet_grad(j)=costhet_fac*pep_side(j)
11837 C remember for the final gradient multiply costhet_grad(j)
11838 C for side_chain by factor -2 !
11839 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
11840 C pep_side0pept_group is vector multiplication
11841 pep_side0pept_group=0.0
11843 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
11845 cosalfa=(pep_side0pept_group/
11846 & (dist_pep_side*dist_side_calf))
11847 fac_alfa_sin=1.0-cosalfa**2
11848 fac_alfa_sin=dsqrt(fac_alfa_sin)
11849 rkprim=fac_alfa_sin*(long-short)+short
11851 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
11852 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
11855 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
11856 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11857 &*(long-short)/fac_alfa_sin*cosalfa/
11858 &((dist_pep_side*dist_side_calf))*
11859 &((side_calf(j))-cosalfa*
11860 &((pep_side(j)/dist_pep_side)*dist_side_calf))
11862 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11863 &*(long-short)/fac_alfa_sin*cosalfa
11864 &/((dist_pep_side*dist_side_calf))*
11866 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
11869 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
11872 C now the gradient...
11873 C grad_shield is gradient of Calfa for peptide groups
11874 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
11876 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
11877 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
11879 grad_shield(j,i)=grad_shield(j,i)
11880 C gradient po skalowaniu
11881 & +(sh_frac_dist_grad(j)
11882 C gradient po costhet
11883 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
11884 &-scale_fac_dist*(cosphi_grad_long(j))
11885 &/(1.0-cosphi) )*div77_81
11887 C grad_shield_side is Cbeta sidechain gradient
11888 grad_shield_side(j,ishield_list(i),i)=
11889 & (sh_frac_dist_grad(j)*-2.0d0
11890 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
11891 & +scale_fac_dist*(cosphi_grad_long(j))
11892 & *2.0d0/(1.0-cosphi))
11893 & *div77_81*VofOverlap
11895 grad_shield_loc(j,ishield_list(i),i)=
11896 & scale_fac_dist*cosphi_grad_loc(j)
11897 & *2.0d0/(1.0-cosphi)
11898 & *div77_81*VofOverlap
11900 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
11902 fac_shield(i)=VolumeTotal*div77_81+div4_81
11903 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
11907 C--------------------------------------------------------------------------
11908 double precision function tschebyshev(m,n,x,y)
11910 include "DIMENSIONS"
11912 double precision x(n),y,yy(0:maxvar),aux
11913 c Tschebyshev polynomial. Note that the first term is omitted
11914 c m=0: the constant term is included
11915 c m=1: the constant term is not included
11919 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
11928 C--------------------------------------------------------------------------
11929 double precision function gradtschebyshev(m,n,x,y)
11931 include "DIMENSIONS"
11933 double precision x(n+1),y,yy(0:maxvar),aux
11934 c Tschebyshev polynomial. Note that the first term is omitted
11935 c m=0: the constant term is included
11936 c m=1: the constant term is not included
11940 yy(i)=2*y*yy(i-1)-yy(i-2)
11944 aux=aux+x(i+1)*yy(i)*(i+1)
11945 C print *, x(i+1),yy(i),i
11947 gradtschebyshev=aux
11950 C------------------------------------------------------------------------
11951 C first for shielding is setting of function of side-chains
11952 subroutine set_shield_fac2
11953 implicit real*8 (a-h,o-z)
11954 include 'DIMENSIONS'
11955 include 'COMMON.CHAIN'
11956 include 'COMMON.DERIV'
11957 include 'COMMON.IOUNITS'
11958 include 'COMMON.SHIELD'
11959 include 'COMMON.INTERACT'
11960 include 'COMMON.LOCAL'
11962 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11963 double precision div77_81/0.974996043d0/,
11964 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11966 C the vector between center of side_chain and peptide group
11967 double precision pep_side(3),long,side_calf(3),
11968 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11969 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11970 C write(2,*) "ivec",ivec_start,ivec_end
11972 fac_shield(i)=0.0d0
11974 grad_shield(j,i)=0.0d0
11977 C the line belowe needs to be changed for FGPROC>1
11978 do i=ivec_start,ivec_end
11980 C if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11982 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11983 Cif there two consequtive dummy atoms there is no peptide group between them
11984 C the line below has to be changed for FGPROC>1
11987 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11991 C first lets set vector conecting the ithe side-chain with kth side-chain
11992 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11993 C pep_side(j)=2.0d0
11994 C and vector conecting the side-chain with its proper calfa
11995 side_calf(j)=c(j,k+nres)-c(j,k)
11996 C side_calf(j)=2.0d0
11997 pept_group(j)=c(j,i)-c(j,i+1)
11998 C lets have their lenght
11999 dist_pep_side=pep_side(j)**2+dist_pep_side
12000 dist_side_calf=dist_side_calf+side_calf(j)**2
12001 dist_pept_group=dist_pept_group+pept_group(j)**2
12003 dist_pep_side=dsqrt(dist_pep_side)
12004 dist_pept_group=dsqrt(dist_pept_group)
12005 dist_side_calf=dsqrt(dist_side_calf)
12007 pep_side_norm(j)=pep_side(j)/dist_pep_side
12008 side_calf_norm(j)=dist_side_calf
12010 C now sscale fraction
12011 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
12012 C print *,buff_shield,"buff"
12014 if (sh_frac_dist.le.0.0) cycle
12015 C print *,ishield_list(i),i
12016 C If we reach here it means that this side chain reaches the shielding sphere
12017 C Lets add him to the list for gradient
12018 ishield_list(i)=ishield_list(i)+1
12019 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
12020 C this list is essential otherwise problem would be O3
12021 shield_list(ishield_list(i),i)=k
12022 C Lets have the sscale value
12023 if (sh_frac_dist.gt.1.0) then
12024 scale_fac_dist=1.0d0
12026 sh_frac_dist_grad(j)=0.0d0
12029 scale_fac_dist=-sh_frac_dist*sh_frac_dist
12030 & *(2.0d0*sh_frac_dist-3.0d0)
12031 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
12032 & /dist_pep_side/buff_shield*0.5d0
12033 C remember for the final gradient multiply sh_frac_dist_grad(j)
12034 C for side_chain by factor -2 !
12036 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
12037 C sh_frac_dist_grad(j)=0.0d0
12038 C scale_fac_dist=1.0d0
12039 C print *,"jestem",scale_fac_dist,fac_help_scale,
12040 C & sh_frac_dist_grad(j)
12043 C this is what is now we have the distance scaling now volume...
12044 short=short_r_sidechain(itype(k))
12045 long=long_r_sidechain(itype(k))
12046 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
12047 sinthet=short/dist_pep_side*costhet
12051 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
12052 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
12053 C & -short/dist_pep_side**2/costhet)
12054 C costhet_fac=0.0d0
12056 costhet_grad(j)=costhet_fac*pep_side(j)
12058 C remember for the final gradient multiply costhet_grad(j)
12059 C for side_chain by factor -2 !
12060 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
12061 C pep_side0pept_group is vector multiplication
12062 pep_side0pept_group=0.0d0
12064 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
12066 cosalfa=(pep_side0pept_group/
12067 & (dist_pep_side*dist_side_calf))
12068 fac_alfa_sin=1.0d0-cosalfa**2
12069 fac_alfa_sin=dsqrt(fac_alfa_sin)
12070 rkprim=fac_alfa_sin*(long-short)+short
12074 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
12076 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
12077 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
12078 & dist_pep_side**2)
12081 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
12082 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
12083 &*(long-short)/fac_alfa_sin*cosalfa/
12084 &((dist_pep_side*dist_side_calf))*
12085 &((side_calf(j))-cosalfa*
12086 &((pep_side(j)/dist_pep_side)*dist_side_calf))
12087 C cosphi_grad_long(j)=0.0d0
12088 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
12089 &*(long-short)/fac_alfa_sin*cosalfa
12090 &/((dist_pep_side*dist_side_calf))*
12092 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
12093 C cosphi_grad_loc(j)=0.0d0
12095 C print *,sinphi,sinthet
12096 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
12099 C now the gradient...
12101 grad_shield(j,i)=grad_shield(j,i)
12102 C gradient po skalowaniu
12103 & +(sh_frac_dist_grad(j)*VofOverlap
12104 C gradient po costhet
12105 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
12106 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
12107 & sinphi/sinthet*costhet*costhet_grad(j)
12108 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
12110 C grad_shield_side is Cbeta sidechain gradient
12111 grad_shield_side(j,ishield_list(i),i)=
12112 & (sh_frac_dist_grad(j)*-2.0d0
12114 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
12115 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
12116 & sinphi/sinthet*costhet*costhet_grad(j)
12117 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
12120 grad_shield_loc(j,ishield_list(i),i)=
12121 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
12122 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
12123 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
12127 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
12129 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
12130 C write(2,*) "TOTAL VOLUME",i,itype(i),fac_shield(i)
12134 C-----------------------------------------------------------------------
12135 C-----------------------------------------------------------
12136 C This subroutine is to mimic the histone like structure but as well can be
12137 C utilizet to nanostructures (infinit) small modification has to be used to
12138 C make it finite (z gradient at the ends has to be changes as well as the x,y
12139 C gradient has to be modified at the ends
12140 C The energy function is Kihara potential
12141 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
12142 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
12143 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
12144 C simple Kihara potential
12145 subroutine calctube(Etube)
12146 implicit real*8 (a-h,o-z)
12147 include 'DIMENSIONS'
12148 include 'COMMON.GEO'
12149 include 'COMMON.VAR'
12150 include 'COMMON.LOCAL'
12151 include 'COMMON.CHAIN'
12152 include 'COMMON.DERIV'
12153 include 'COMMON.NAMES'
12154 include 'COMMON.INTERACT'
12155 include 'COMMON.IOUNITS'
12156 include 'COMMON.CALC'
12157 include 'COMMON.CONTROL'
12158 include 'COMMON.SPLITELE'
12159 include 'COMMON.SBRIDGE'
12160 double precision tub_r,vectube(3),enetube(maxres*2)
12162 do i=itube_start,itube_end
12164 enetube(i+nres)=0.0d0
12166 C first we calculate the distance from tube center
12167 C first sugare-phosphate group for NARES this would be peptide group
12169 do i=itube_start,itube_end
12170 C lets ommit dummy atoms for now
12171 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
12172 C now calculate distance from center of tube and direction vectors
12176 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
12177 vectube(1)=vectube(1)+boxxsize*j
12178 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
12179 vectube(2)=vectube(2)+boxysize*j
12181 xminact=abs(vectube(1)-tubecenter(1))
12182 yminact=abs(vectube(2)-tubecenter(2))
12183 if (xmin.gt.xminact) then
12187 if (ymin.gt.yminact) then
12194 vectube(1)=vectube(1)-tubecenter(1)
12195 vectube(2)=vectube(2)-tubecenter(2)
12197 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
12198 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
12200 C as the tube is infinity we do not calculate the Z-vector use of Z
12203 C now calculte the distance
12204 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12205 C now normalize vector
12206 vectube(1)=vectube(1)/tub_r
12207 vectube(2)=vectube(2)/tub_r
12208 C calculte rdiffrence between r and r0
12211 rdiff6=rdiff**6.0d0
12212 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12213 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
12214 C write(iout,*) "TU13",i,rdiff6,enetube(i)
12215 C print *,rdiff,rdiff6,pep_aa_tube
12216 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12217 C now we calculate gradient
12218 fac=(-12.0d0*pep_aa_tube/rdiff6-
12219 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
12220 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
12223 C now direction of gg_tube vector
12225 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
12226 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
12229 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
12230 C print *,gg_tube(1,0),"TU"
12233 do i=itube_start,itube_end
12234 C Lets not jump over memory as we use many times iti
12236 C lets ommit dummy atoms for now
12238 C in UNRES uncomment the line below as GLY has no side-chain...
12244 vectube(1)=mod((c(1,i+nres)),boxxsize)
12245 vectube(1)=vectube(1)+boxxsize*j
12246 vectube(2)=mod((c(2,i+nres)),boxysize)
12247 vectube(2)=vectube(2)+boxysize*j
12249 xminact=abs(vectube(1)-tubecenter(1))
12250 yminact=abs(vectube(2)-tubecenter(2))
12251 if (xmin.gt.xminact) then
12255 if (ymin.gt.yminact) then
12262 C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
12264 vectube(1)=vectube(1)-tubecenter(1)
12265 vectube(2)=vectube(2)-tubecenter(2)
12267 C as the tube is infinity we do not calculate the Z-vector use of Z
12270 C now calculte the distance
12271 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12272 C now normalize vector
12273 vectube(1)=vectube(1)/tub_r
12274 vectube(2)=vectube(2)/tub_r
12276 C calculte rdiffrence between r and r0
12279 rdiff6=rdiff**6.0d0
12280 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12281 sc_aa_tube=sc_aa_tube_par(iti)
12282 sc_bb_tube=sc_bb_tube_par(iti)
12283 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
12284 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12285 C now we calculate gradient
12286 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
12287 & 6.0d0*sc_bb_tube/rdiff6/rdiff
12288 C now direction of gg_tube vector
12290 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
12291 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
12294 do i=itube_start,itube_end
12295 Etube=Etube+enetube(i)+enetube(i+nres)
12297 C print *,"ETUBE", etube
12300 C TO DO 1) add to total energy
12301 C 2) add to gradient summation
12302 C 3) add reading parameters (AND of course oppening of PARAM file)
12303 C 4) add reading the center of tube
12305 C 6) add to zerograd
12307 C-----------------------------------------------------------------------
12308 C-----------------------------------------------------------
12309 C This subroutine is to mimic the histone like structure but as well can be
12310 C utilizet to nanostructures (infinit) small modification has to be used to
12311 C make it finite (z gradient at the ends has to be changes as well as the x,y
12312 C gradient has to be modified at the ends
12313 C The energy function is Kihara potential
12314 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
12315 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
12316 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
12317 C simple Kihara potential
12318 subroutine calctube2(Etube)
12319 implicit real*8 (a-h,o-z)
12320 include 'DIMENSIONS'
12321 include 'COMMON.GEO'
12322 include 'COMMON.VAR'
12323 include 'COMMON.LOCAL'
12324 include 'COMMON.CHAIN'
12325 include 'COMMON.DERIV'
12326 include 'COMMON.NAMES'
12327 include 'COMMON.INTERACT'
12328 include 'COMMON.IOUNITS'
12329 include 'COMMON.CALC'
12330 include 'COMMON.CONTROL'
12331 include 'COMMON.SPLITELE'
12332 include 'COMMON.SBRIDGE'
12333 double precision tub_r,vectube(3),enetube(maxres*2)
12335 do i=itube_start,itube_end
12337 enetube(i+nres)=0.0d0
12339 C first we calculate the distance from tube center
12340 C first sugare-phosphate group for NARES this would be peptide group
12342 do i=itube_start,itube_end
12343 C lets ommit dummy atoms for now
12345 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
12346 C now calculate distance from center of tube and direction vectors
12347 C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
12348 C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
12349 C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
12350 C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
12354 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
12355 vectube(1)=vectube(1)+boxxsize*j
12356 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
12357 vectube(2)=vectube(2)+boxysize*j
12359 xminact=abs(vectube(1)-tubecenter(1))
12360 yminact=abs(vectube(2)-tubecenter(2))
12361 if (xmin.gt.xminact) then
12365 if (ymin.gt.yminact) then
12372 vectube(1)=vectube(1)-tubecenter(1)
12373 vectube(2)=vectube(2)-tubecenter(2)
12375 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
12376 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
12378 C as the tube is infinity we do not calculate the Z-vector use of Z
12381 C now calculte the distance
12382 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12383 C now normalize vector
12384 vectube(1)=vectube(1)/tub_r
12385 vectube(2)=vectube(2)/tub_r
12386 C calculte rdiffrence between r and r0
12389 rdiff6=rdiff**6.0d0
12390 C THIS FRAGMENT MAKES TUBE FINITE
12391 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
12392 if (positi.le.0) positi=positi+boxzsize
12393 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
12394 c for each residue check if it is in lipid or lipid water border area
12395 C respos=mod(c(3,i+nres),boxzsize)
12396 print *,positi,bordtubebot,buftubebot,bordtubetop
12397 if ((positi.gt.bordtubebot)
12398 & .and.(positi.lt.bordtubetop)) then
12399 C the energy transfer exist
12400 if (positi.lt.buftubebot) then
12402 & ((positi-bordtubebot)/tubebufthick)
12403 C lipbufthick is thickenes of lipid buffore
12404 sstube=sscalelip(fracinbuf)
12405 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
12406 print *,ssgradtube, sstube,tubetranene(itype(i))
12407 enetube(i)=enetube(i)+sstube*tubetranenepep
12408 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
12409 C &+ssgradtube*tubetranene(itype(i))
12410 C gg_tube(3,i-1)= gg_tube(3,i-1)
12411 C &+ssgradtube*tubetranene(itype(i))
12412 C print *,"doing sccale for lower part"
12413 elseif (positi.gt.buftubetop) then
12415 &((bordtubetop-positi)/tubebufthick)
12416 sstube=sscalelip(fracinbuf)
12417 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
12418 enetube(i)=enetube(i)+sstube*tubetranenepep
12419 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
12420 C &+ssgradtube*tubetranene(itype(i))
12421 C gg_tube(3,i-1)= gg_tube(3,i-1)
12422 C &+ssgradtube*tubetranene(itype(i))
12423 C print *, "doing sscalefor top part",sslip,fracinbuf
12427 enetube(i)=enetube(i)+sstube*tubetranenepep
12428 C print *,"I am in true lipid"
12434 endif ! if in lipid or buffor
12436 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12437 enetube(i)=enetube(i)+sstube*
12438 &(pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
12439 C write(iout,*) "TU13",i,rdiff6,enetube(i)
12440 C print *,rdiff,rdiff6,pep_aa_tube
12441 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12442 C now we calculate gradient
12443 fac=(-12.0d0*pep_aa_tube/rdiff6-
12444 & 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
12445 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
12448 C now direction of gg_tube vector
12450 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
12451 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
12453 gg_tube(3,i)=gg_tube(3,i)
12454 &+ssgradtube*enetube(i)/sstube/2.0d0
12455 gg_tube(3,i-1)= gg_tube(3,i-1)
12456 &+ssgradtube*enetube(i)/sstube/2.0d0
12459 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
12460 C print *,gg_tube(1,0),"TU"
12461 do i=itube_start,itube_end
12462 C Lets not jump over memory as we use many times iti
12464 C lets ommit dummy atoms for now
12466 C in UNRES uncomment the line below as GLY has no side-chain...
12469 vectube(1)=c(1,i+nres)
12470 vectube(1)=mod(vectube(1),boxxsize)
12471 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
12472 vectube(2)=c(2,i+nres)
12473 vectube(2)=mod(vectube(2),boxysize)
12474 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
12476 vectube(1)=vectube(1)-tubecenter(1)
12477 vectube(2)=vectube(2)-tubecenter(2)
12478 C THIS FRAGMENT MAKES TUBE FINITE
12479 positi=(mod(c(3,i+nres),boxzsize))
12480 if (positi.le.0) positi=positi+boxzsize
12481 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
12482 c for each residue check if it is in lipid or lipid water border area
12483 C respos=mod(c(3,i+nres),boxzsize)
12484 print *,positi,bordtubebot,buftubebot,bordtubetop
12485 if ((positi.gt.bordtubebot)
12486 & .and.(positi.lt.bordtubetop)) then
12487 C the energy transfer exist
12488 if (positi.lt.buftubebot) then
12490 & ((positi-bordtubebot)/tubebufthick)
12491 C lipbufthick is thickenes of lipid buffore
12492 sstube=sscalelip(fracinbuf)
12493 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
12494 print *,ssgradtube, sstube,tubetranene(itype(i))
12495 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
12496 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
12497 C &+ssgradtube*tubetranene(itype(i))
12498 C gg_tube(3,i-1)= gg_tube(3,i-1)
12499 C &+ssgradtube*tubetranene(itype(i))
12500 C print *,"doing sccale for lower part"
12501 elseif (positi.gt.buftubetop) then
12503 &((bordtubetop-positi)/tubebufthick)
12504 sstube=sscalelip(fracinbuf)
12505 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
12506 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
12507 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
12508 C &+ssgradtube*tubetranene(itype(i))
12509 C gg_tube(3,i-1)= gg_tube(3,i-1)
12510 C &+ssgradtube*tubetranene(itype(i))
12511 C print *, "doing sscalefor top part",sslip,fracinbuf
12515 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
12516 C print *,"I am in true lipid"
12522 endif ! if in lipid or buffor
12523 CEND OF FINITE FRAGMENT
12524 C as the tube is infinity we do not calculate the Z-vector use of Z
12527 C now calculte the distance
12528 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12529 C now normalize vector
12530 vectube(1)=vectube(1)/tub_r
12531 vectube(2)=vectube(2)/tub_r
12532 C calculte rdiffrence between r and r0
12535 rdiff6=rdiff**6.0d0
12536 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12537 sc_aa_tube=sc_aa_tube_par(iti)
12538 sc_bb_tube=sc_bb_tube_par(iti)
12539 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)
12540 & *sstube+enetube(i+nres)
12541 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12542 C now we calculate gradient
12543 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
12544 & 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
12545 C now direction of gg_tube vector
12547 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
12548 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
12550 gg_tube_SC(3,i)=gg_tube_SC(3,i)
12551 &+ssgradtube*enetube(i+nres)/sstube
12552 gg_tube(3,i-1)= gg_tube(3,i-1)
12553 &+ssgradtube*enetube(i+nres)/sstube
12556 do i=itube_start,itube_end
12557 Etube=Etube+enetube(i)+enetube(i+nres)
12559 C print *,"ETUBE", etube
12562 C TO DO 1) add to total energy
12563 C 2) add to gradient summation
12564 C 3) add reading parameters (AND of course oppening of PARAM file)
12565 C 4) add reading the center of tube
12567 C 6) add to zerograd
12570 C#-------------------------------------------------------------------------------
12571 C This subroutine is to mimic the histone like structure but as well can be
12572 C utilizet to nanostructures (infinit) small modification has to be used to
12573 C make it finite (z gradient at the ends has to be changes as well as the x,y
12574 C gradient has to be modified at the ends
12575 C The energy function is Kihara potential
12576 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
12577 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
12578 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
12579 C simple Kihara potential
12580 subroutine calcnano(Etube)
12581 implicit real*8 (a-h,o-z)
12582 include 'DIMENSIONS'
12583 include 'COMMON.GEO'
12584 include 'COMMON.VAR'
12585 include 'COMMON.LOCAL'
12586 include 'COMMON.CHAIN'
12587 include 'COMMON.DERIV'
12588 include 'COMMON.NAMES'
12589 include 'COMMON.INTERACT'
12590 include 'COMMON.IOUNITS'
12591 include 'COMMON.CALC'
12592 include 'COMMON.CONTROL'
12593 include 'COMMON.SPLITELE'
12594 include 'COMMON.SBRIDGE'
12595 double precision tub_r,vectube(3),enetube(maxres*2),
12596 & enecavtube(maxres*2)
12598 do i=itube_start,itube_end
12600 enetube(i+nres)=0.0d0
12602 C first we calculate the distance from tube center
12603 C first sugare-phosphate group for NARES this would be peptide group
12605 do i=itube_start,itube_end
12606 C lets ommit dummy atoms for now
12607 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
12608 C now calculate distance from center of tube and direction vectors
12614 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
12615 vectube(1)=vectube(1)+boxxsize*j
12616 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
12617 vectube(2)=vectube(2)+boxysize*j
12618 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
12619 vectube(3)=vectube(3)+boxzsize*j
12622 xminact=dabs(vectube(1)-tubecenter(1))
12623 yminact=dabs(vectube(2)-tubecenter(2))
12624 zminact=dabs(vectube(3)-tubecenter(3))
12626 if (xmin.gt.xminact) then
12630 if (ymin.gt.yminact) then
12634 if (zmin.gt.zminact) then
12643 vectube(1)=vectube(1)-tubecenter(1)
12644 vectube(2)=vectube(2)-tubecenter(2)
12645 vectube(3)=vectube(3)-tubecenter(3)
12647 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
12648 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
12649 C as the tube is infinity we do not calculate the Z-vector use of Z
12652 C now calculte the distance
12653 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12654 C now normalize vector
12655 vectube(1)=vectube(1)/tub_r
12656 vectube(2)=vectube(2)/tub_r
12657 vectube(3)=vectube(3)/tub_r
12658 C calculte rdiffrence between r and r0
12661 rdiff6=rdiff**6.0d0
12662 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12663 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
12664 C write(iout,*) "TU13",i,rdiff6,enetube(i)
12665 C print *,rdiff,rdiff6,pep_aa_tube
12666 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12667 C now we calculate gradient
12668 fac=(-12.0d0*pep_aa_tube/rdiff6-
12669 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
12670 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
12672 if (acavtubpep.eq.0.0d0) then
12677 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
12679 & (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep)
12682 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff))
12683 & *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)
12684 & +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0)
12685 & /denominator**2.0d0
12690 C print *,"TUT",i,iti,rdiff,rdiff6,acavtubpep,denominator,
12691 C & enecavtube(i),faccav
12693 C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
12694 CX print *,"finene=",enetube(i+nres)+enecavtube(i)
12696 C now direction of gg_tube vector
12698 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
12699 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
12703 do i=itube_start,itube_end
12704 enecavtube(i)=0.0d0
12705 C Lets not jump over memory as we use many times iti
12707 C lets ommit dummy atoms for now
12709 C in UNRES uncomment the line below as GLY has no side-chain...
12716 vectube(1)=dmod((c(1,i+nres)),boxxsize)
12717 vectube(1)=vectube(1)+boxxsize*j
12718 vectube(2)=dmod((c(2,i+nres)),boxysize)
12719 vectube(2)=vectube(2)+boxysize*j
12720 vectube(3)=dmod((c(3,i+nres)),boxzsize)
12721 vectube(3)=vectube(3)+boxzsize*j
12724 xminact=dabs(vectube(1)-tubecenter(1))
12725 yminact=dabs(vectube(2)-tubecenter(2))
12726 zminact=dabs(vectube(3)-tubecenter(3))
12728 if (xmin.gt.xminact) then
12732 if (ymin.gt.yminact) then
12736 if (zmin.gt.zminact) then
12745 C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
12747 vectube(1)=vectube(1)-tubecenter(1)
12748 vectube(2)=vectube(2)-tubecenter(2)
12749 vectube(3)=vectube(3)-tubecenter(3)
12750 C now calculte the distance
12751 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12752 C now normalize vector
12753 vectube(1)=vectube(1)/tub_r
12754 vectube(2)=vectube(2)/tub_r
12755 vectube(3)=vectube(3)/tub_r
12757 C calculte rdiffrence between r and r0
12760 rdiff6=rdiff**6.0d0
12761 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12762 sc_aa_tube=sc_aa_tube_par(iti)
12763 sc_bb_tube=sc_bb_tube_par(iti)
12764 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
12765 C enetube(i+nres)=0.0d0
12766 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12767 C now we calculate gradient
12768 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
12769 & 6.0d0*sc_bb_tube/rdiff6/rdiff
12771 C now direction of gg_tube vector
12772 C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
12773 if (acavtub(iti).eq.0.0d0) then
12775 enecavtube(i+nres)=0.0d0
12778 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
12779 enecavtube(i+nres)=
12780 & (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti))
12782 C enecavtube(i)=0.0
12783 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff))
12784 & *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)
12785 & +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0)
12786 & /denominator**2.0d0
12791 C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
12792 C & enecavtube(i),faccav
12794 C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
12795 C print *,"finene=",enetube(i+nres)+enecavtube(i)
12797 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
12798 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
12801 C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
12802 C do i=itube_start,itube_end
12805 C if (acavtub(iti).eq.0.0) cycle
12809 do i=itube_start,itube_end
12810 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i)
12811 & +enecavtube(i+nres)
12813 C print *,"ETUBE", etube
12816 C TO DO 1) add to total energy
12817 C 2) add to gradient summation
12818 C 3) add reading parameters (AND of course oppening of PARAM file)
12819 C 4) add reading the center of tube
12821 C 6) add to zerograd