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=dmod(xmedi,boxxsize)
3696 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3697 ymedi=dmod(ymedi,boxysize)
3698 if (ymedi.lt.0) ymedi=ymedi+boxysize
3699 zmedi=dmod(zmedi,boxzsize)
3700 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3701 zmedi2=dmod(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=dmod(xmedi,boxxsize)
3761 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3762 ymedi=dmod(ymedi,boxysize)
3763 if (ymedi.lt.0) ymedi=ymedi+boxysize
3764 zmedi=dmod(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
3977 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3979 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3980 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3981 C Condition for being inside the proper box
3982 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3983 c & (xj.lt.((-0.5d0)*boxxsize))) then
3987 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3988 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3989 C Condition for being inside the proper box
3990 c if ((yj.gt.((0.5d0)*boxysize)).or.
3991 c & (yj.lt.((-0.5d0)*boxysize))) then
3995 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3996 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3997 C Condition for being inside the proper box
3998 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3999 c & (zj.lt.((-0.5d0)*boxzsize))) then
4002 C endif !endPBC condintion
4006 rij=xj*xj+yj*yj+zj*zj
4008 sss=sscale(sqrt(rij))
4009 sssgrad=sscagrad(sqrt(rij))
4010 c if (sss.gt.0.0d0) then
4016 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
4017 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
4018 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
4019 fac=cosa-3.0D0*cosb*cosg
4021 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
4022 if (j.eq.i+2) ev1=scal_el*ev1
4027 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
4031 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
4032 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
4033 if (shield_mode.gt.0) then
4036 el1=el1*fac_shield(i)**2*fac_shield(j)**2
4037 el2=el2*fac_shield(i)**2*fac_shield(j)**2
4040 C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
4041 C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4047 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4048 C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
4050 evdw1=evdw1+evdwij*sss
4051 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4052 C print *,sslipi,sslipj,lipscale**2,
4053 C & (sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
4054 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
4055 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
4056 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
4057 cd & xmedi,ymedi,zmedi,xj,yj,zj
4059 if (energy_dec) then
4060 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
4062 &,iteli,itelj,aaa,evdw1
4064 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
4065 &fac_shield(i),fac_shield(j)
4069 C Calculate contributions to the Cartesian gradient.
4072 facvdw=-6*rrmij*(ev1+evdwij)*sss
4073 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4074 facel=-3*rrmij*(el1+eesij)
4075 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4082 * Radial derivatives. First process both termini of the fragment (i,j)
4087 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4088 & (shield_mode.gt.0)) then
4090 do ilist=1,ishield_list(i)
4091 iresshield=shield_list(ilist,i)
4093 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
4095 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
4097 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
4098 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
4099 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
4100 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
4101 C if (iresshield.gt.i) then
4102 C do ishi=i+1,iresshield-1
4103 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
4104 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
4108 C do ishi=iresshield,i
4109 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
4110 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
4116 do ilist=1,ishield_list(j)
4117 iresshield=shield_list(ilist,j)
4119 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
4121 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
4123 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
4124 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
4126 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4127 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
4128 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4129 C if (iresshield.gt.j) then
4130 C do ishi=j+1,iresshield-1
4131 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
4132 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4136 C do ishi=iresshield,j
4137 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
4138 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4145 gshieldc(k,i)=gshieldc(k,i)+
4146 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
4147 gshieldc(k,j)=gshieldc(k,j)+
4148 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
4149 gshieldc(k,i-1)=gshieldc(k,i-1)+
4150 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
4151 gshieldc(k,j-1)=gshieldc(k,j-1)+
4152 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
4157 c ghalf=0.5D0*ggg(k)
4158 c gelc(k,i)=gelc(k,i)+ghalf
4159 c gelc(k,j)=gelc(k,j)+ghalf
4161 c 9/28/08 AL Gradient compotents will be summed only at the end
4162 C print *,"before", gelc_long(1,i), gelc_long(1,j)
4164 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4165 C & +grad_shield(k,j)*eesij/fac_shield(j)
4166 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4167 C & +grad_shield(k,i)*eesij/fac_shield(i)
4168 C gelc_long(k,i-1)=gelc_long(k,i-1)
4169 C & +grad_shield(k,i)*eesij/fac_shield(i)
4170 C gelc_long(k,j-1)=gelc_long(k,j-1)
4171 C & +grad_shield(k,j)*eesij/fac_shield(j)
4173 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
4174 C Lipidic part for lipscale
4175 gelc_long(3,j)=gelc_long(3,j)+
4176 & ssgradlipj*eesij/2.0d0*lipscale**2
4177 C if ((ssgradlipj*eesij/2.0d0*lipscale**2).ne.0.0 )
4178 C & write(iout,*) "WTF",j
4179 gelc_long(3,i)=gelc_long(3,i)+
4180 & ssgradlipi*eesij/2.0d0*lipscale**2
4182 C if ((ssgradlipi*eesij/2.0d0*lipscale**2).ne.0.0 )
4183 C & write(iout,*) "WTF",i
4186 * Loop over residues i+1 thru j-1.
4190 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4193 if (sss.gt.0.0) then
4194 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
4195 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4197 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
4198 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4200 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
4201 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4208 c ghalf=0.5D0*ggg(k)
4209 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
4210 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
4212 c 9/28/08 AL Gradient compotents will be summed only at the end
4214 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4215 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4217 C Lipidic part for scaling weight
4218 gvdwpp(3,j)=gvdwpp(3,j)+
4219 & sss*ssgradlipj*evdwij/2.0d0*lipscale**2
4220 gvdwpp(3,i)=gvdwpp(3,i)+
4221 & sss*ssgradlipi*evdwij/2.0d0*lipscale**2
4224 * Loop over residues i+1 thru j-1.
4228 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
4233 facvdw=(ev1+evdwij)*sss
4234 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4237 fac=-3*rrmij*(facvdw+facvdw+facel)
4242 * Radial derivatives. First process both termini of the fragment (i,j)
4245 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
4247 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
4249 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
4251 c ghalf=0.5D0*ggg(k)
4252 c gelc(k,i)=gelc(k,i)+ghalf
4253 c gelc(k,j)=gelc(k,j)+ghalf
4255 c 9/28/08 AL Gradient compotents will be summed only at the end
4257 gelc_long(k,j)=gelc(k,j)+ggg(k)
4258 gelc_long(k,i)=gelc(k,i)-ggg(k)
4261 * Loop over residues i+1 thru j-1.
4265 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4268 c 9/28/08 AL Gradient compotents will be summed only at the end
4269 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
4270 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4272 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
4273 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4275 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
4276 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4278 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4279 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4281 gvdwpp(3,j)=gvdwpp(3,j)+
4282 & sss*ssgradlipj*evdwij/2.0d0*lipscale**2
4283 gvdwpp(3,i)=gvdwpp(3,i)+
4284 & sss*ssgradlipi*evdwij/2.0d0*lipscale**2
4290 ecosa=2.0D0*fac3*fac1+fac4
4293 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
4294 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
4296 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4297 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4299 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
4300 cd & (dcosg(k),k=1,3)
4302 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
4303 & fac_shield(i)**2*fac_shield(j)**2
4304 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4307 c ghalf=0.5D0*ggg(k)
4308 c gelc(k,i)=gelc(k,i)+ghalf
4309 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4310 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4311 c gelc(k,j)=gelc(k,j)+ghalf
4312 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4313 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4317 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4320 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
4323 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4324 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
4325 & *fac_shield(i)**2*fac_shield(j)**2
4326 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4328 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4329 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
4330 & *fac_shield(i)**2*fac_shield(j)**2
4331 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4332 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4333 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4335 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
4339 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
4340 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
4341 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4343 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
4344 C energy of a peptide unit is assumed in the form of a second-order
4345 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
4346 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
4347 C are computed for EVERY pair of non-contiguous peptide groups.
4350 if (j.lt.nres-1) then
4362 muij(kkk)=mu(k,i)*mu(l,j)
4363 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
4365 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
4366 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
4367 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
4368 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
4369 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
4370 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4374 cd write (iout,*) 'EELEC: i',i,' j',j
4375 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
4376 cd write(iout,*) 'muij',muij
4377 ury=scalar(uy(1,i),erij)
4378 urz=scalar(uz(1,i),erij)
4379 vry=scalar(uy(1,j),erij)
4380 vrz=scalar(uz(1,j),erij)
4381 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4382 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4383 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4384 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4385 fac=dsqrt(-ael6i)*r3ij
4390 cd write (iout,'(4i5,4f10.5)')
4391 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
4392 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4393 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4394 cd & uy(:,j),uz(:,j)
4395 cd write (iout,'(4f10.5)')
4396 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4397 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4398 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
4399 cd write (iout,'(9f10.5/)')
4400 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4401 C Derivatives of the elements of A in virtual-bond vectors
4402 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4404 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4405 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4406 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4407 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4408 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4409 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4410 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4411 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4412 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4413 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4414 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4415 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4417 C Compute radial contributions to the gradient
4435 C Add the contributions coming from er
4438 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4439 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4440 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4441 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4444 C Derivatives in DC(i)
4445 cgrad ghalf1=0.5d0*agg(k,1)
4446 cgrad ghalf2=0.5d0*agg(k,2)
4447 cgrad ghalf3=0.5d0*agg(k,3)
4448 cgrad ghalf4=0.5d0*agg(k,4)
4449 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
4450 & -3.0d0*uryg(k,2)*vry)!+ghalf1
4451 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
4452 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
4453 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
4454 & -3.0d0*urzg(k,2)*vry)!+ghalf3
4455 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
4456 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
4457 C Derivatives in DC(i+1)
4458 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
4459 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4460 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
4461 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4462 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
4463 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4464 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
4465 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4466 C Derivatives in DC(j)
4467 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
4468 & -3.0d0*vryg(k,2)*ury)!+ghalf1
4469 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4470 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4471 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4472 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4473 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4474 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4475 C Derivatives in DC(j+1) or DC(nres-1)
4476 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4477 & -3.0d0*vryg(k,3)*ury)
4478 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4479 & -3.0d0*vrzg(k,3)*ury)
4480 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4481 & -3.0d0*vryg(k,3)*urz)
4482 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4483 & -3.0d0*vrzg(k,3)*urz)
4484 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4486 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4499 aggi(k,l)=-aggi(k,l)
4500 aggi1(k,l)=-aggi1(k,l)
4501 aggj(k,l)=-aggj(k,l)
4502 aggj1(k,l)=-aggj1(k,l)
4505 if (j.lt.nres-1) then
4511 aggi(k,l)=-aggi(k,l)
4512 aggi1(k,l)=-aggi1(k,l)
4513 aggj(k,l)=-aggj(k,l)
4514 aggj1(k,l)=-aggj1(k,l)
4525 aggi(k,l)=-aggi(k,l)
4526 aggi1(k,l)=-aggi1(k,l)
4527 aggj(k,l)=-aggj(k,l)
4528 aggj1(k,l)=-aggj1(k,l)
4533 IF (wel_loc.gt.0.0d0) THEN
4534 C Contribution to the local-electrostatic energy coming from the i-j pair
4535 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4537 if (shield_mode.eq.0) then
4544 eel_loc_ij=eel_loc_ij
4545 & *fac_shield(i)*fac_shield(j)
4546 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4548 C Now derivative over eel_loc
4549 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4550 & (shield_mode.gt.0)) then
4553 do ilist=1,ishield_list(i)
4554 iresshield=shield_list(ilist,i)
4556 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
4559 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4561 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
4562 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4566 do ilist=1,ishield_list(j)
4567 iresshield=shield_list(ilist,j)
4569 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
4572 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4574 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
4575 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4582 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
4583 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4584 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
4585 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4586 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
4587 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4588 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
4589 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4594 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4595 c & ' eel_loc_ij',eel_loc_ij
4596 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4597 C Calculate patrial derivative for theta angle
4599 geel_loc_ij=(a22*gmuij1(1)
4603 & *fac_shield(i)*fac_shield(j)
4604 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4606 c write(iout,*) "derivative over thatai"
4607 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4609 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4610 & geel_loc_ij*wel_loc
4611 c write(iout,*) "derivative over thatai-1"
4612 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4619 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4620 & geel_loc_ij*wel_loc
4621 & *fac_shield(i)*fac_shield(j)
4622 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4625 c Derivative over j residue
4626 geel_loc_ji=a22*gmuji1(1)
4630 c write(iout,*) "derivative over thataj"
4631 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4634 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4635 & geel_loc_ji*wel_loc
4636 & *fac_shield(i)*fac_shield(j)
4637 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4644 c write(iout,*) "derivative over thataj-1"
4645 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4647 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4648 & geel_loc_ji*wel_loc
4649 & *fac_shield(i)*fac_shield(j)
4650 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4653 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4655 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2f7.3)')
4656 & 'eelloc',i,j,eel_loc_ij,a22*muij(1),a23*muij(2)
4657 c if (eel_loc_ij.ne.0)
4658 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4659 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4661 eel_loc=eel_loc+eel_loc_ij
4662 C Partial derivatives in virtual-bond dihedral angles gamma
4664 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4665 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4666 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
4667 & *fac_shield(i)*fac_shield(j)
4668 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4670 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4671 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4672 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
4673 & *fac_shield(i)*fac_shield(j)
4674 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4676 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4678 ggg(l)=(agg(l,1)*muij(1)+
4679 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
4680 & *fac_shield(i)*fac_shield(j)
4681 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4683 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4684 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4685 cgrad ghalf=0.5d0*ggg(l)
4686 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4687 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4689 gel_loc_long(3,j)=gel_loc_long(3,j)+
4690 & ssgradlipj*eel_loc_ij/2.0d0*lipscale/
4691 & ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4693 gel_loc_long(3,i)=gel_loc_long(3,i)+
4694 & ssgradlipi*eel_loc_ij/2.0d0*lipscale/
4695 & ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4699 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4702 C Remaining derivatives of eello
4704 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4705 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4706 & *fac_shield(i)*fac_shield(j)
4707 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4709 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4710 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4711 & *fac_shield(i)*fac_shield(j)
4712 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4714 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4715 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4716 & *fac_shield(i)*fac_shield(j)
4717 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4719 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4720 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4721 & *fac_shield(i)*fac_shield(j)
4722 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4726 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4727 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4728 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4729 & .and. num_conti.le.maxconts) then
4730 c write (iout,*) i,j," entered corr"
4732 C Calculate the contact function. The ith column of the array JCONT will
4733 C contain the numbers of atoms that make contacts with the atom I (of numbers
4734 C greater than I). The arrays FACONT and GACONT will contain the values of
4735 C the contact function and its derivative.
4736 c r0ij=1.02D0*rpp(iteli,itelj)
4737 c r0ij=1.11D0*rpp(iteli,itelj)
4738 r0ij=2.20D0*rpp(iteli,itelj)
4739 c r0ij=1.55D0*rpp(iteli,itelj)
4740 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4741 if (fcont.gt.0.0D0) then
4742 num_conti=num_conti+1
4743 if (num_conti.gt.maxconts) then
4744 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4745 & ' will skip next contacts for this conf.'
4747 jcont_hb(num_conti,i)=j
4748 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4749 cd & " jcont_hb",jcont_hb(num_conti,i)
4750 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4751 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4752 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4754 d_cont(num_conti,i)=rij
4755 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4756 C --- Electrostatic-interaction matrix ---
4757 a_chuj(1,1,num_conti,i)=a22
4758 a_chuj(1,2,num_conti,i)=a23
4759 a_chuj(2,1,num_conti,i)=a32
4760 a_chuj(2,2,num_conti,i)=a33
4761 C --- Gradient of rij
4763 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4770 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4771 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4772 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4773 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4774 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4779 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4780 C Calculate contact energies
4782 wij=cosa-3.0D0*cosb*cosg
4785 c fac3=dsqrt(-ael6i)/r0ij**3
4786 fac3=dsqrt(-ael6i)*r3ij
4787 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4788 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4789 if (ees0tmp.gt.0) then
4790 ees0pij=dsqrt(ees0tmp)
4794 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4795 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4796 if (ees0tmp.gt.0) then
4797 ees0mij=dsqrt(ees0tmp)
4802 if (shield_mode.eq.0) then
4806 ees0plist(num_conti,i)=j
4807 C fac_shield(i)=0.4d0
4808 C fac_shield(j)=0.6d0
4810 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4811 & *fac_shield(i)*fac_shield(j)
4812 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4813 & *fac_shield(i)*fac_shield(j)
4814 C Diagnostics. Comment out or remove after debugging!
4815 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4816 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4817 c ees0m(num_conti,i)=0.0D0
4819 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4820 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4821 C Angular derivatives of the contact function
4822 ees0pij1=fac3/ees0pij
4823 ees0mij1=fac3/ees0mij
4824 fac3p=-3.0D0*fac3*rrmij
4825 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4826 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4828 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4829 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4830 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4831 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4832 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4833 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4834 ecosap=ecosa1+ecosa2
4835 ecosbp=ecosb1+ecosb2
4836 ecosgp=ecosg1+ecosg2
4837 ecosam=ecosa1-ecosa2
4838 ecosbm=ecosb1-ecosb2
4839 ecosgm=ecosg1-ecosg2
4848 facont_hb(num_conti,i)=fcont
4849 fprimcont=fprimcont/rij
4850 cd facont_hb(num_conti,i)=1.0D0
4851 C Following line is for diagnostics.
4854 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4855 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4858 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4859 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4861 gggp(1)=gggp(1)+ees0pijp*xj
4862 gggp(2)=gggp(2)+ees0pijp*yj
4863 gggp(3)=gggp(3)+ees0pijp*zj
4864 gggm(1)=gggm(1)+ees0mijp*xj
4865 gggm(2)=gggm(2)+ees0mijp*yj
4866 gggm(3)=gggm(3)+ees0mijp*zj
4867 C Derivatives due to the contact function
4868 gacont_hbr(1,num_conti,i)=fprimcont*xj
4869 gacont_hbr(2,num_conti,i)=fprimcont*yj
4870 gacont_hbr(3,num_conti,i)=fprimcont*zj
4873 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4874 c following the change of gradient-summation algorithm.
4876 cgrad ghalfp=0.5D0*gggp(k)
4877 cgrad ghalfm=0.5D0*gggm(k)
4878 gacontp_hb1(k,num_conti,i)=!ghalfp
4879 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4880 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4881 & *fac_shield(i)*fac_shield(j)
4883 gacontp_hb2(k,num_conti,i)=!ghalfp
4884 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4885 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4886 & *fac_shield(i)*fac_shield(j)
4888 gacontp_hb3(k,num_conti,i)=gggp(k)
4889 & *fac_shield(i)*fac_shield(j)
4891 gacontm_hb1(k,num_conti,i)=!ghalfm
4892 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4893 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4894 & *fac_shield(i)*fac_shield(j)
4896 gacontm_hb2(k,num_conti,i)=!ghalfm
4897 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4898 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4899 & *fac_shield(i)*fac_shield(j)
4901 gacontm_hb3(k,num_conti,i)=gggm(k)
4902 & *fac_shield(i)*fac_shield(j)
4905 C Diagnostics. Comment out or remove after debugging!
4907 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4908 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4909 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4910 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4911 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4912 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4915 endif ! num_conti.le.maxconts
4918 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4921 ghalf=0.5d0*agg(l,k)
4922 aggi(l,k)=aggi(l,k)+ghalf
4923 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4924 aggj(l,k)=aggj(l,k)+ghalf
4927 if (j.eq.nres-1 .and. i.lt.j-2) then
4930 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4935 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4938 C-----------------------------------------------------------------------------
4939 subroutine eturn3(i,eello_turn3)
4940 C Third- and fourth-order contributions from turns
4941 implicit real*8 (a-h,o-z)
4942 include 'DIMENSIONS'
4943 include 'COMMON.IOUNITS'
4944 include 'COMMON.GEO'
4945 include 'COMMON.VAR'
4946 include 'COMMON.LOCAL'
4947 include 'COMMON.CHAIN'
4948 include 'COMMON.DERIV'
4949 include 'COMMON.INTERACT'
4950 include 'COMMON.CONTACTS'
4951 include 'COMMON.TORSION'
4952 include 'COMMON.VECTORS'
4953 include 'COMMON.FFIELD'
4954 include 'COMMON.CONTROL'
4955 include 'COMMON.SHIELD'
4957 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4958 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4959 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4960 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4961 & auxgmat2(2,2),auxgmatt2(2,2)
4962 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4963 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4964 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4965 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4968 C xj=(c(1,j)+c(1,j+1))/2.0d0
4969 C yj=(c(2,j)+c(2,j+1))/2.0d0
4970 zj=(c(3,j)+c(3,j+1))/2.0d0
4971 C xj=mod(xj,boxxsize)
4972 C if (xj.lt.0) xj=xj+boxxsize
4973 C yj=mod(yj,boxysize)
4974 C if (yj.lt.0) yj=yj+boxysize
4976 if (zj.lt.0) zj=zj+boxzsize
4977 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
4978 if ((zj.gt.bordlipbot)
4979 &.and.(zj.lt.bordliptop)) then
4980 C the energy transfer exist
4981 if (zj.lt.buflipbot) then
4982 C what fraction I am in
4984 & ((zj-bordlipbot)/lipbufthick)
4985 C lipbufthick is thickenes of lipid buffore
4986 sslipj=sscalelip(fracinbuf)
4987 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4988 elseif (zj.gt.bufliptop) then
4989 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4990 sslipj=sscalelip(fracinbuf)
4991 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
5003 C write (iout,*) "eturn3",i,j,j1,j2
5008 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5010 C Third-order contributions
5017 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5018 cd call checkint_turn3(i,a_temp,eello_turn3_num)
5019 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
5020 c auxalary matices for theta gradient
5021 c auxalary matrix for i+1 and constant i+2
5022 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
5023 c auxalary matrix for i+2 and constant i+1
5024 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
5025 call transpose2(auxmat(1,1),auxmat1(1,1))
5026 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
5027 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
5028 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5029 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
5030 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
5031 if (shield_mode.eq.0) then
5039 C & write(iout,*) i,j,fac_shield(i),fac_shield(j)
5040 eello_turn3=eello_turn3+
5041 C & 1.0*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5042 &0.5d0*(pizda(1,1)+pizda(2,2))
5043 & *fac_shield(i)*fac_shield(j)
5044 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5046 &0.5d0*(pizda(1,1)+pizda(2,2))
5047 & *fac_shield(i)*fac_shield(j)
5049 C Derivatives in theta
5050 gloc(nphi+i,icg)=gloc(nphi+i,icg)
5051 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
5052 & *fac_shield(i)*fac_shield(j)
5053 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5055 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
5056 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
5057 & *fac_shield(i)*fac_shield(j)
5058 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5062 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5063 C Derivatives in shield mode
5064 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
5065 & (shield_mode.gt.0)) then
5068 do ilist=1,ishield_list(i)
5069 iresshield=shield_list(ilist,i)
5071 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
5073 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
5075 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
5076 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
5080 do ilist=1,ishield_list(j)
5081 iresshield=shield_list(ilist,j)
5083 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
5085 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
5087 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
5088 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
5095 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
5096 & grad_shield(k,i)*eello_t3/fac_shield(i)
5097 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
5098 & grad_shield(k,j)*eello_t3/fac_shield(j)
5099 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
5100 & grad_shield(k,i)*eello_t3/fac_shield(i)
5101 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
5102 & grad_shield(k,j)*eello_t3/fac_shield(j)
5106 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5107 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
5108 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
5109 cd & ' eello_turn3_num',4*eello_turn3_num
5110 C Derivatives in gamma(i)
5111 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
5112 call transpose2(auxmat2(1,1),auxmat3(1,1))
5113 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
5114 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
5115 & *fac_shield(i)*fac_shield(j)
5116 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5118 C Derivatives in gamma(i+1)
5119 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
5120 call transpose2(auxmat2(1,1),auxmat3(1,1))
5121 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
5122 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
5123 & +0.5d0*(pizda(1,1)+pizda(2,2))
5124 & *fac_shield(i)*fac_shield(j)
5125 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5127 C Cartesian derivatives
5129 c ghalf1=0.5d0*agg(l,1)
5130 c ghalf2=0.5d0*agg(l,2)
5131 c ghalf3=0.5d0*agg(l,3)
5132 c ghalf4=0.5d0*agg(l,4)
5133 a_temp(1,1)=aggi(l,1)!+ghalf1
5134 a_temp(1,2)=aggi(l,2)!+ghalf2
5135 a_temp(2,1)=aggi(l,3)!+ghalf3
5136 a_temp(2,2)=aggi(l,4)!+ghalf4
5137 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5138 gcorr3_turn(l,i)=gcorr3_turn(l,i)
5139 & +0.5d0*(pizda(1,1)+pizda(2,2))
5140 & *fac_shield(i)*fac_shield(j)
5141 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5143 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
5144 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
5145 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
5146 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
5147 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5148 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
5149 & +0.5d0*(pizda(1,1)+pizda(2,2))
5150 & *fac_shield(i)*fac_shield(j)
5151 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5152 a_temp(1,1)=aggj(l,1)!+ghalf1
5153 a_temp(1,2)=aggj(l,2)!+ghalf2
5154 a_temp(2,1)=aggj(l,3)!+ghalf3
5155 a_temp(2,2)=aggj(l,4)!+ghalf4
5156 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5157 gcorr3_turn(l,j)=gcorr3_turn(l,j)
5158 & +0.5d0*(pizda(1,1)+pizda(2,2))
5159 & *fac_shield(i)*fac_shield(j)
5160 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5162 a_temp(1,1)=aggj1(l,1)
5163 a_temp(1,2)=aggj1(l,2)
5164 a_temp(2,1)=aggj1(l,3)
5165 a_temp(2,2)=aggj1(l,4)
5166 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5167 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
5168 & +0.5d0*(pizda(1,1)+pizda(2,2))
5169 & *fac_shield(i)*fac_shield(j)
5170 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5172 gshieldc_t3(3,i)=gshieldc_t3(3,i)+
5173 & ssgradlipi*eello_t3/4.0d0*lipscale
5174 gshieldc_t3(3,j)=gshieldc_t3(3,j)+
5175 & ssgradlipj*eello_t3/4.0d0*lipscale
5176 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+
5177 & ssgradlipi*eello_t3/4.0d0*lipscale
5178 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+
5179 & ssgradlipj*eello_t3/4.0d0*lipscale
5181 C print *,ssgradlipi,ssgradlipj,eello_t3,sslipi,sslipj
5184 C-------------------------------------------------------------------------------
5185 subroutine eturn4(i,eello_turn4)
5186 C Third- and fourth-order contributions from turns
5187 implicit real*8 (a-h,o-z)
5188 include 'DIMENSIONS'
5189 include 'COMMON.IOUNITS'
5190 include 'COMMON.GEO'
5191 include 'COMMON.VAR'
5192 include 'COMMON.LOCAL'
5193 include 'COMMON.CHAIN'
5194 include 'COMMON.DERIV'
5195 include 'COMMON.INTERACT'
5196 include 'COMMON.CONTACTS'
5197 include 'COMMON.TORSION'
5198 include 'COMMON.VECTORS'
5199 include 'COMMON.FFIELD'
5200 include 'COMMON.CONTROL'
5201 include 'COMMON.SHIELD'
5203 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
5204 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
5205 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
5206 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
5207 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
5208 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
5209 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
5210 double precision agg(3,4),aggi(3,4),aggi1(3,4),
5211 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
5212 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
5213 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
5216 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5218 C Fourth-order contributions
5226 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5227 cd call checkint_turn4(i,a_temp,eello_turn4_num)
5228 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
5229 c write(iout,*)"WCHODZE W PROGRAM"
5230 zj=(c(3,j)+c(3,j+1))/2.0d0
5231 C xj=mod(xj,boxxsize)
5232 C if (xj.lt.0) xj=xj+boxxsize
5233 C yj=mod(yj,boxysize)
5234 C if (yj.lt.0) yj=yj+boxysize
5236 if (zj.lt.0) zj=zj+boxzsize
5237 C if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
5238 if ((zj.gt.bordlipbot)
5239 &.and.(zj.lt.bordliptop)) then
5240 C the energy transfer exist
5241 if (zj.lt.buflipbot) then
5242 C what fraction I am in
5244 & ((zj-bordlipbot)/lipbufthick)
5245 C lipbufthick is thickenes of lipid buffore
5246 sslipj=sscalelip(fracinbuf)
5247 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
5248 elseif (zj.gt.bufliptop) then
5249 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
5250 sslipj=sscalelip(fracinbuf)
5251 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
5265 iti1=itype2loc(itype(i+1))
5266 iti2=itype2loc(itype(i+2))
5267 iti3=itype2loc(itype(i+3))
5268 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
5269 call transpose2(EUg(1,1,i+1),e1t(1,1))
5270 call transpose2(Eug(1,1,i+2),e2t(1,1))
5271 call transpose2(Eug(1,1,i+3),e3t(1,1))
5272 C Ematrix derivative in theta
5273 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
5274 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
5275 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
5276 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5277 c eta1 in derivative theta
5278 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
5279 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5280 c auxgvec is derivative of Ub2 so i+3 theta
5281 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
5282 c auxalary matrix of E i+1
5283 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
5286 s1=scalar2(b1(1,i+2),auxvec(1))
5287 c derivative of theta i+2 with constant i+3
5288 gs23=scalar2(gtb1(1,i+2),auxvec(1))
5289 c derivative of theta i+2 with constant i+2
5290 gs32=scalar2(b1(1,i+2),auxgvec(1))
5291 c derivative of E matix in theta of i+1
5292 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
5294 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5295 c ea31 in derivative theta
5296 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
5297 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5298 c auxilary matrix auxgvec of Ub2 with constant E matirx
5299 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
5300 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
5301 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
5305 s2=scalar2(b1(1,i+1),auxvec(1))
5306 c derivative of theta i+1 with constant i+3
5307 gs13=scalar2(gtb1(1,i+1),auxvec(1))
5308 c derivative of theta i+2 with constant i+1
5309 gs21=scalar2(b1(1,i+1),auxgvec(1))
5310 c derivative of theta i+3 with constant i+1
5311 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
5312 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
5314 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5315 c two derivatives over diffetent matrices
5316 c gtae3e2 is derivative over i+3
5317 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
5318 c ae3gte2 is derivative over i+2
5319 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
5320 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5321 c three possible derivative over theta E matices
5323 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
5325 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
5327 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
5328 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5330 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
5331 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
5332 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
5333 if (shield_mode.eq.0) then
5340 eello_turn4=eello_turn4-(s1+s2+s3)
5341 & *fac_shield(i)*fac_shield(j)
5342 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5344 eello_t4=-(s1+s2+s3)
5345 & *fac_shield(i)*fac_shield(j)
5346 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
5347 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
5348 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
5349 C Now derivative over shield:
5350 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
5351 & (shield_mode.gt.0)) then
5354 do ilist=1,ishield_list(i)
5355 iresshield=shield_list(ilist,i)
5357 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
5359 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
5361 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
5362 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
5366 do ilist=1,ishield_list(j)
5367 iresshield=shield_list(ilist,j)
5369 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
5371 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
5373 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
5374 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
5381 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
5382 & grad_shield(k,i)*eello_t4/fac_shield(i)
5383 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
5384 & grad_shield(k,j)*eello_t4/fac_shield(j)
5385 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
5386 & grad_shield(k,i)*eello_t4/fac_shield(i)
5387 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
5388 & grad_shield(k,j)*eello_t4/fac_shield(j)
5397 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5398 cd & ' eello_turn4_num',8*eello_turn4_num
5400 gloc(nphi+i,icg)=gloc(nphi+i,icg)
5401 & -(gs13+gsE13+gsEE1)*wturn4
5402 & *fac_shield(i)*fac_shield(j)
5403 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5405 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
5406 & -(gs23+gs21+gsEE2)*wturn4
5407 & *fac_shield(i)*fac_shield(j)
5408 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5410 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
5411 & -(gs32+gsE31+gsEE3)*wturn4
5412 & *fac_shield(i)*fac_shield(j)
5413 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5415 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
5418 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5419 & 'eturn4',i,j,-(s1+s2+s3)
5420 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5421 c & ' eello_turn4_num',8*eello_turn4_num
5422 C Derivatives in gamma(i)
5423 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
5424 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
5425 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
5426 s1=scalar2(b1(1,i+2),auxvec(1))
5427 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
5428 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5429 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
5430 & *fac_shield(i)*fac_shield(j)
5431 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5433 C Derivatives in gamma(i+1)
5434 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
5435 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
5436 s2=scalar2(b1(1,i+1),auxvec(1))
5437 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5438 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5439 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5440 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
5441 & *fac_shield(i)*fac_shield(j)
5442 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5444 C Derivatives in gamma(i+2)
5445 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5446 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5447 s1=scalar2(b1(1,i+2),auxvec(1))
5448 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5449 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5450 s2=scalar2(b1(1,i+1),auxvec(1))
5451 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5452 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5453 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5454 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
5455 & *fac_shield(i)*fac_shield(j)
5456 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5458 C Cartesian derivatives
5459 C Derivatives of this turn contributions in DC(i+2)
5460 if (j.lt.nres-1) then
5462 a_temp(1,1)=agg(l,1)
5463 a_temp(1,2)=agg(l,2)
5464 a_temp(2,1)=agg(l,3)
5465 a_temp(2,2)=agg(l,4)
5466 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5467 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5468 s1=scalar2(b1(1,i+2),auxvec(1))
5469 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5470 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5471 s2=scalar2(b1(1,i+1),auxvec(1))
5472 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5473 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5474 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5476 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
5477 & *fac_shield(i)*fac_shield(j)
5478 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5482 C Remaining derivatives of this turn contribution
5484 a_temp(1,1)=aggi(l,1)
5485 a_temp(1,2)=aggi(l,2)
5486 a_temp(2,1)=aggi(l,3)
5487 a_temp(2,2)=aggi(l,4)
5488 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5489 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5490 s1=scalar2(b1(1,i+2),auxvec(1))
5491 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5492 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5493 s2=scalar2(b1(1,i+1),auxvec(1))
5494 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5495 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5496 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5497 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
5498 & *fac_shield(i)*fac_shield(j)
5499 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5501 a_temp(1,1)=aggi1(l,1)
5502 a_temp(1,2)=aggi1(l,2)
5503 a_temp(2,1)=aggi1(l,3)
5504 a_temp(2,2)=aggi1(l,4)
5505 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5506 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5507 s1=scalar2(b1(1,i+2),auxvec(1))
5508 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5509 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5510 s2=scalar2(b1(1,i+1),auxvec(1))
5511 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5512 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5513 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5514 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
5515 & *fac_shield(i)*fac_shield(j)
5516 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5518 a_temp(1,1)=aggj(l,1)
5519 a_temp(1,2)=aggj(l,2)
5520 a_temp(2,1)=aggj(l,3)
5521 a_temp(2,2)=aggj(l,4)
5522 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5523 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5524 s1=scalar2(b1(1,i+2),auxvec(1))
5525 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5526 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5527 s2=scalar2(b1(1,i+1),auxvec(1))
5528 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5529 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5530 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5531 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
5532 & *fac_shield(i)*fac_shield(j)
5533 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5535 a_temp(1,1)=aggj1(l,1)
5536 a_temp(1,2)=aggj1(l,2)
5537 a_temp(2,1)=aggj1(l,3)
5538 a_temp(2,2)=aggj1(l,4)
5539 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5540 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5541 s1=scalar2(b1(1,i+2),auxvec(1))
5542 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5543 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5544 s2=scalar2(b1(1,i+1),auxvec(1))
5545 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5546 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5547 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5548 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5549 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
5550 & *fac_shield(i)*fac_shield(j)
5551 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5553 gshieldc_t4(3,i)=gshieldc_t4(3,i)+
5554 & ssgradlipi*eello_t4/4.0d0*lipscale
5555 gshieldc_t4(3,j)=gshieldc_t4(3,j)+
5556 & ssgradlipj*eello_t4/4.0d0*lipscale
5557 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+
5558 & ssgradlipi*eello_t4/4.0d0*lipscale
5559 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+
5560 & ssgradlipj*eello_t4/4.0d0*lipscale
5563 C-----------------------------------------------------------------------------
5564 subroutine vecpr(u,v,w)
5565 implicit real*8(a-h,o-z)
5566 dimension u(3),v(3),w(3)
5567 w(1)=u(2)*v(3)-u(3)*v(2)
5568 w(2)=-u(1)*v(3)+u(3)*v(1)
5569 w(3)=u(1)*v(2)-u(2)*v(1)
5572 C-----------------------------------------------------------------------------
5573 subroutine unormderiv(u,ugrad,unorm,ungrad)
5574 C This subroutine computes the derivatives of a normalized vector u, given
5575 C the derivatives computed without normalization conditions, ugrad. Returns
5578 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
5579 double precision vec(3)
5580 double precision scalar
5582 c write (2,*) 'ugrad',ugrad
5585 vec(i)=scalar(ugrad(1,i),u(1))
5587 c write (2,*) 'vec',vec
5590 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5593 c write (2,*) 'ungrad',ungrad
5596 C-----------------------------------------------------------------------------
5597 subroutine escp_soft_sphere(evdw2,evdw2_14)
5599 C This subroutine calculates the excluded-volume interaction energy between
5600 C peptide-group centers and side chains and its gradient in virtual-bond and
5601 C side-chain vectors.
5603 implicit real*8 (a-h,o-z)
5604 include 'DIMENSIONS'
5605 include 'COMMON.GEO'
5606 include 'COMMON.VAR'
5607 include 'COMMON.LOCAL'
5608 include 'COMMON.CHAIN'
5609 include 'COMMON.DERIV'
5610 include 'COMMON.INTERACT'
5611 include 'COMMON.FFIELD'
5612 include 'COMMON.IOUNITS'
5613 include 'COMMON.CONTROL'
5618 cd print '(a)','Enter ESCP'
5619 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5623 do i=iatscp_s,iatscp_e
5624 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5626 xi=0.5D0*(c(1,i)+c(1,i+1))
5627 yi=0.5D0*(c(2,i)+c(2,i+1))
5628 zi=0.5D0*(c(3,i)+c(3,i+1))
5629 C Return atom into box, boxxsize is size of box in x dimension
5631 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5632 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5633 C Condition for being inside the proper box
5634 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5635 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5639 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5640 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5641 C Condition for being inside the proper box
5642 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5643 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5647 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5648 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5649 cC Condition for being inside the proper box
5650 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5651 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5655 if (xi.lt.0) xi=xi+boxxsize
5657 if (yi.lt.0) yi=yi+boxysize
5659 if (zi.lt.0) zi=zi+boxzsize
5660 C xi=xi+xshift*boxxsize
5661 C yi=yi+yshift*boxysize
5662 C zi=zi+zshift*boxzsize
5663 do iint=1,nscp_gr(i)
5665 do j=iscpstart(i,iint),iscpend(i,iint)
5666 if (itype(j).eq.ntyp1) cycle
5667 itypj=iabs(itype(j))
5668 C Uncomment following three lines for SC-p interactions
5672 C Uncomment following three lines for Ca-p interactions
5677 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5678 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5679 C Condition for being inside the proper box
5680 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5681 c & (xj.lt.((-0.5d0)*boxxsize))) then
5685 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5686 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5687 cC Condition for being inside the proper box
5688 c if ((yj.gt.((0.5d0)*boxysize)).or.
5689 c & (yj.lt.((-0.5d0)*boxysize))) then
5693 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5694 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5695 C Condition for being inside the proper box
5696 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5697 c & (zj.lt.((-0.5d0)*boxzsize))) then
5700 if (xj.lt.0) xj=xj+boxxsize
5702 if (yj.lt.0) yj=yj+boxysize
5704 if (zj.lt.0) zj=zj+boxzsize
5705 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5713 xj=xj_safe+xshift*boxxsize
5714 yj=yj_safe+yshift*boxysize
5715 zj=zj_safe+zshift*boxzsize
5716 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5717 if(dist_temp.lt.dist_init) then
5727 if (subchap.eq.1) then
5740 rij=xj*xj+yj*yj+zj*zj
5744 if (rij.lt.r0ijsq) then
5745 evdwij=0.25d0*(rij-r0ijsq)**2
5753 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5758 cgrad if (j.lt.i) then
5759 cd write (iout,*) 'j<i'
5760 C Uncomment following three lines for SC-p interactions
5762 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5765 cd write (iout,*) 'j>i'
5767 cgrad ggg(k)=-ggg(k)
5768 C Uncomment following line for SC-p interactions
5769 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5773 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5775 cgrad kstart=min0(i+1,j)
5776 cgrad kend=max0(i-1,j-1)
5777 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5778 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5779 cgrad do k=kstart,kend
5781 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5785 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5786 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5797 C-----------------------------------------------------------------------------
5798 subroutine escp(evdw2,evdw2_14)
5800 C This subroutine calculates the excluded-volume interaction energy between
5801 C peptide-group centers and side chains and its gradient in virtual-bond and
5802 C side-chain vectors.
5804 implicit real*8 (a-h,o-z)
5805 include 'DIMENSIONS'
5806 include 'COMMON.GEO'
5807 include 'COMMON.VAR'
5808 include 'COMMON.LOCAL'
5809 include 'COMMON.CHAIN'
5810 include 'COMMON.DERIV'
5811 include 'COMMON.INTERACT'
5812 include 'COMMON.FFIELD'
5813 include 'COMMON.IOUNITS'
5814 include 'COMMON.CONTROL'
5815 include 'COMMON.SPLITELE'
5819 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
5820 cd print '(a)','Enter ESCP'
5821 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5825 do i=iatscp_s,iatscp_e
5826 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5828 xi=0.5D0*(c(1,i)+c(1,i+1))
5829 yi=0.5D0*(c(2,i)+c(2,i+1))
5830 zi=0.5D0*(c(3,i)+c(3,i+1))
5832 if (xi.lt.0) xi=xi+boxxsize
5834 if (yi.lt.0) yi=yi+boxysize
5836 if (zi.lt.0) zi=zi+boxzsize
5837 c xi=xi+xshift*boxxsize
5838 c yi=yi+yshift*boxysize
5839 c zi=zi+zshift*boxzsize
5840 c print *,xi,yi,zi,'polozenie i'
5841 C Return atom into box, boxxsize is size of box in x dimension
5843 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5844 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5845 C Condition for being inside the proper box
5846 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5847 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5851 c print *,xi,boxxsize,"pierwszy"
5853 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5854 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5855 C Condition for being inside the proper box
5856 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5857 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5861 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5862 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5863 C Condition for being inside the proper box
5864 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5865 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5868 do iint=1,nscp_gr(i)
5870 do j=iscpstart(i,iint),iscpend(i,iint)
5871 itypj=iabs(itype(j))
5872 if (itypj.eq.ntyp1) cycle
5873 C Uncomment following three lines for SC-p interactions
5877 C Uncomment following three lines for Ca-p interactions
5882 if (xj.lt.0) xj=xj+boxxsize
5884 if (yj.lt.0) yj=yj+boxysize
5886 if (zj.lt.0) zj=zj+boxzsize
5888 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5889 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5890 C Condition for being inside the proper box
5891 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5892 c & (xj.lt.((-0.5d0)*boxxsize))) then
5896 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5897 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5898 cC Condition for being inside the proper box
5899 c if ((yj.gt.((0.5d0)*boxysize)).or.
5900 c & (yj.lt.((-0.5d0)*boxysize))) then
5904 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5905 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5906 C Condition for being inside the proper box
5907 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5908 c & (zj.lt.((-0.5d0)*boxzsize))) then
5911 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5912 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5920 xj=xj_safe+xshift*boxxsize
5921 yj=yj_safe+yshift*boxysize
5922 zj=zj_safe+zshift*boxzsize
5923 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5924 if(dist_temp.lt.dist_init) then
5934 if (subchap.eq.1) then
5943 c print *,xj,yj,zj,'polozenie j'
5944 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5946 sss=sscale(1.0d0/(dsqrt(rrij)))
5947 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5948 c if (sss.eq.0) print *,'czasem jest OK'
5949 if (sss.le.0.0d0) cycle
5950 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5952 e1=fac*fac*aad(itypj,iteli)
5953 e2=fac*bad(itypj,iteli)
5954 if (iabs(j-i) .le. 2) then
5957 evdw2_14=evdw2_14+(e1+e2)*sss
5960 evdw2=evdw2+evdwij*sss
5961 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5962 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5965 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5967 fac=-(evdwij+e1)*rrij*sss
5968 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5972 cgrad if (j.lt.i) then
5973 cd write (iout,*) 'j<i'
5974 C Uncomment following three lines for SC-p interactions
5976 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5979 cd write (iout,*) 'j>i'
5981 cgrad ggg(k)=-ggg(k)
5982 C Uncomment following line for SC-p interactions
5983 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5984 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5988 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5990 cgrad kstart=min0(i+1,j)
5991 cgrad kend=max0(i-1,j-1)
5992 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5993 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5994 cgrad do k=kstart,kend
5996 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
6000 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
6001 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
6003 c endif !endif for sscale cutoff
6013 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
6014 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
6015 gradx_scp(j,i)=expon*gradx_scp(j,i)
6018 C******************************************************************************
6022 C To save time the factor EXPON has been extracted from ALL components
6023 C of GVDWC and GRADX. Remember to multiply them by this factor before further
6026 C******************************************************************************
6029 C--------------------------------------------------------------------------
6030 subroutine edis(ehpb)
6032 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
6034 implicit real*8 (a-h,o-z)
6035 include 'DIMENSIONS'
6036 include 'COMMON.SBRIDGE'
6037 include 'COMMON.CHAIN'
6038 include 'COMMON.DERIV'
6039 include 'COMMON.VAR'
6040 include 'COMMON.INTERACT'
6041 include 'COMMON.IOUNITS'
6042 include 'COMMON.CONTROL'
6048 C write (iout,*) ,"link_end",link_end,constr_dist
6049 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
6050 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
6051 if (link_end.eq.0) return
6052 do i=link_start,link_end
6053 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
6054 C CA-CA distance used in regularization of structure.
6057 C iii and jjj point to the residues for which the distance is assigned.
6058 if (ii.gt.nres) then
6065 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
6066 c & dhpb(i),dhpb1(i),forcon(i)
6067 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
6068 C distance and angle dependent SS bond potential.
6069 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
6070 C & iabs(itype(jjj)).eq.1) then
6071 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
6072 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
6073 if (.not.dyn_ss .and. i.le.nss) then
6074 C 15/02/13 CC dynamic SSbond - additional check
6075 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
6076 & iabs(itype(jjj)).eq.1) then
6077 call ssbond_ene(iii,jjj,eij)
6080 cd write (iout,*) "eij",eij
6081 cd & ' waga=',waga,' fac=',fac
6082 else if (ii.gt.nres .and. jj.gt.nres) then
6083 c Restraints from contact prediction
6085 if (constr_dist.eq.11) then
6086 ehpb=ehpb+fordepth(i)**4.0d0
6087 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
6088 fac=fordepth(i)**4.0d0
6089 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
6090 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
6091 & ehpb,fordepth(i),dd
6093 if (dhpb1(i).gt.0.0d0) then
6094 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6095 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
6096 c write (iout,*) "beta nmr",
6097 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6101 C Get the force constant corresponding to this distance.
6103 C Calculate the contribution to energy.
6104 ehpb=ehpb+waga*rdis*rdis
6105 c write (iout,*) "beta reg",dd,waga*rdis*rdis
6107 C Evaluate gradient.
6113 ggg(j)=fac*(c(j,jj)-c(j,ii))
6116 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
6117 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
6120 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
6121 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
6124 C Calculate the distance between the two points and its difference from the
6127 if (constr_dist.eq.11) then
6128 ehpb=ehpb+fordepth(i)**4.0d0
6129 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
6130 fac=fordepth(i)**4.0d0
6131 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
6132 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
6133 & ehpb,fordepth(i),dd
6135 if (dhpb1(i).gt.0.0d0) then
6136 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6137 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
6138 c write (iout,*) "alph nmr",
6139 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6142 C Get the force constant corresponding to this distance.
6144 C Calculate the contribution to energy.
6145 ehpb=ehpb+waga*rdis*rdis
6146 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
6148 C Evaluate gradient.
6154 ggg(j)=fac*(c(j,jj)-c(j,ii))
6156 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
6157 C If this is a SC-SC distance, we need to calculate the contributions to the
6158 C Cartesian gradient in the SC vectors (ghpbx).
6161 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
6162 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
6165 cgrad do j=iii,jjj-1
6167 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
6171 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
6172 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
6176 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
6179 C--------------------------------------------------------------------------
6180 subroutine ssbond_ene(i,j,eij)
6182 C Calculate the distance and angle dependent SS-bond potential energy
6183 C using a free-energy function derived based on RHF/6-31G** ab initio
6184 C calculations of diethyl disulfide.
6186 C A. Liwo and U. Kozlowska, 11/24/03
6188 implicit real*8 (a-h,o-z)
6189 include 'DIMENSIONS'
6190 include 'COMMON.SBRIDGE'
6191 include 'COMMON.CHAIN'
6192 include 'COMMON.DERIV'
6193 include 'COMMON.LOCAL'
6194 include 'COMMON.INTERACT'
6195 include 'COMMON.VAR'
6196 include 'COMMON.IOUNITS'
6197 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
6198 itypi=iabs(itype(i))
6202 dxi=dc_norm(1,nres+i)
6203 dyi=dc_norm(2,nres+i)
6204 dzi=dc_norm(3,nres+i)
6205 c dsci_inv=dsc_inv(itypi)
6206 dsci_inv=vbld_inv(nres+i)
6207 itypj=iabs(itype(j))
6208 c dscj_inv=dsc_inv(itypj)
6209 dscj_inv=vbld_inv(nres+j)
6213 dxj=dc_norm(1,nres+j)
6214 dyj=dc_norm(2,nres+j)
6215 dzj=dc_norm(3,nres+j)
6216 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
6221 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
6222 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
6223 om12=dxi*dxj+dyi*dyj+dzi*dzj
6225 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
6226 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
6232 deltat12=om2-om1+2.0d0
6234 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
6235 & +akct*deltad*deltat12
6236 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
6237 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
6238 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
6239 c & " deltat12",deltat12," eij",eij
6240 ed=2*akcm*deltad+akct*deltat12
6242 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
6243 eom1=-2*akth*deltat1-pom1-om2*pom2
6244 eom2= 2*akth*deltat2+pom1-om1*pom2
6247 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
6248 ghpbx(k,i)=ghpbx(k,i)-ggk
6249 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
6250 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
6251 ghpbx(k,j)=ghpbx(k,j)+ggk
6252 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
6253 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
6254 ghpbc(k,i)=ghpbc(k,i)-ggk
6255 ghpbc(k,j)=ghpbc(k,j)+ggk
6258 C Calculate the components of the gradient in DC and X
6262 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
6267 C--------------------------------------------------------------------------
6268 subroutine ebond(estr)
6270 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
6272 implicit real*8 (a-h,o-z)
6273 include 'DIMENSIONS'
6274 include 'COMMON.LOCAL'
6275 include 'COMMON.GEO'
6276 include 'COMMON.INTERACT'
6277 include 'COMMON.DERIV'
6278 include 'COMMON.VAR'
6279 include 'COMMON.CHAIN'
6280 include 'COMMON.IOUNITS'
6281 include 'COMMON.NAMES'
6282 include 'COMMON.FFIELD'
6283 include 'COMMON.CONTROL'
6284 include 'COMMON.SETUP'
6285 double precision u(3),ud(3)
6288 do i=ibondp_start,ibondp_end
6289 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
6290 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
6292 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
6293 c & *dc(j,i-1)/vbld(i)
6295 c if (energy_dec) write(iout,*)
6296 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
6298 C Checking if it involves dummy (NH3+ or COO-) group
6299 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
6300 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
6301 diff = vbld(i)-vbldpDUM
6302 if (energy_dec) write(iout,*) "dum_bond",i,diff
6304 C NO vbldp0 is the equlibrium lenght of spring for peptide group
6305 diff = vbld(i)-vbldp0
6307 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
6308 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
6311 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
6313 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
6317 estr=0.5d0*AKP*estr+estr1
6319 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
6321 do i=ibond_start,ibond_end
6323 if (iti.ne.10 .and. iti.ne.ntyp1) then
6326 diff=vbld(i+nres)-vbldsc0(1,iti)
6327 if (energy_dec) write (iout,*)
6328 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
6329 & AKSC(1,iti),AKSC(1,iti)*diff*diff
6330 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
6332 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
6336 diff=vbld(i+nres)-vbldsc0(j,iti)
6337 if (energy_dec) write (iout,*)
6338 & "estr sc",i,iti,vbld(i+nres),vbldsc0(j,iti),diff,
6339 & AKSC(j,iti),AKSC(j,iti)*diff*diff
6340 ud(j)=aksc(j,iti)*diff
6341 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
6355 uprod2=uprod2*u(k)*u(k)
6359 usumsqder=usumsqder+ud(j)*uprod2
6361 estr=estr+uprod/usum
6363 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
6371 C--------------------------------------------------------------------------
6372 subroutine ebend(etheta,ethetacnstr)
6374 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6375 C angles gamma and its derivatives in consecutive thetas and gammas.
6377 implicit real*8 (a-h,o-z)
6378 include 'DIMENSIONS'
6379 include 'COMMON.LOCAL'
6380 include 'COMMON.GEO'
6381 include 'COMMON.INTERACT'
6382 include 'COMMON.DERIV'
6383 include 'COMMON.VAR'
6384 include 'COMMON.CHAIN'
6385 include 'COMMON.IOUNITS'
6386 include 'COMMON.NAMES'
6387 include 'COMMON.FFIELD'
6388 include 'COMMON.CONTROL'
6389 include 'COMMON.TORCNSTR'
6390 common /calcthet/ term1,term2,termm,diffak,ratak,
6391 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6392 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6393 double precision y(2),z(2)
6395 c time11=dexp(-2*time)
6398 c write (*,'(a,i2)') 'EBEND ICG=',icg
6399 do i=ithet_start,ithet_end
6400 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6401 & .or.itype(i).eq.ntyp1) cycle
6402 C Zero the energy function and its derivative at 0 or pi.
6403 call splinthet(theta(i),0.5d0*delta,ss,ssd)
6405 ichir1=isign(1,itype(i-2))
6406 ichir2=isign(1,itype(i))
6407 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
6408 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
6409 if (itype(i-1).eq.10) then
6410 itype1=isign(10,itype(i-2))
6411 ichir11=isign(1,itype(i-2))
6412 ichir12=isign(1,itype(i-2))
6413 itype2=isign(10,itype(i))
6414 ichir21=isign(1,itype(i))
6415 ichir22=isign(1,itype(i))
6418 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
6421 if (phii.ne.phii) phii=150.0
6431 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6434 if (phii1.ne.phii1) phii1=150.0
6446 C Calculate the "mean" value of theta from the part of the distribution
6447 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
6448 C In following comments this theta will be referred to as t_c.
6449 thet_pred_mean=0.0d0
6451 athetk=athet(k,it,ichir1,ichir2)
6452 bthetk=bthet(k,it,ichir1,ichir2)
6454 athetk=athet(k,itype1,ichir11,ichir12)
6455 bthetk=bthet(k,itype2,ichir21,ichir22)
6457 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
6458 c write(iout,*) 'chuj tu', y(k),z(k)
6460 dthett=thet_pred_mean*ssd
6461 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
6462 C Derivatives of the "mean" values in gamma1 and gamma2.
6463 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
6464 &+athet(2,it,ichir1,ichir2)*y(1))*ss
6465 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
6466 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
6468 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
6469 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
6470 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
6471 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
6473 if (theta(i).gt.pi-delta) then
6474 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
6476 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
6477 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6478 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
6480 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
6482 else if (theta(i).lt.delta) then
6483 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
6484 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6485 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
6487 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
6488 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
6491 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
6494 etheta=etheta+ethetai
6495 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
6496 & 'ebend',i,ethetai,theta(i),itype(i)
6497 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
6498 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
6499 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
6502 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6503 do i=ithetaconstr_start,ithetaconstr_end
6504 itheta=itheta_constr(i)
6505 thetiii=theta(itheta)
6506 difi=pinorm(thetiii-theta_constr0(i))
6507 if (difi.gt.theta_drange(i)) then
6508 difi=difi-theta_drange(i)
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
6512 else if (difi.lt.-drange(i)) then
6514 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6515 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6516 & +for_thet_constr(i)*difi**3
6520 if (energy_dec) then
6521 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6522 & i,itheta,rad2deg*thetiii,
6523 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6524 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6525 & gloc(itheta+nphi-2,icg)
6529 C Ufff.... We've done all this!!!
6532 C---------------------------------------------------------------------------
6533 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
6535 implicit real*8 (a-h,o-z)
6536 include 'DIMENSIONS'
6537 include 'COMMON.LOCAL'
6538 include 'COMMON.IOUNITS'
6539 common /calcthet/ term1,term2,termm,diffak,ratak,
6540 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6541 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6542 C Calculate the contributions to both Gaussian lobes.
6543 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6544 C The "polynomial part" of the "standard deviation" of this part of
6545 C the distributioni.
6546 ccc write (iout,*) thetai,thet_pred_mean
6549 sig=sig*thet_pred_mean+polthet(j,it)
6551 C Derivative of the "interior part" of the "standard deviation of the"
6552 C gamma-dependent Gaussian lobe in t_c.
6553 sigtc=3*polthet(3,it)
6555 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6558 C Set the parameters of both Gaussian lobes of the distribution.
6559 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6560 fac=sig*sig+sigc0(it)
6563 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6564 sigsqtc=-4.0D0*sigcsq*sigtc
6565 c print *,i,sig,sigtc,sigsqtc
6566 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
6567 sigtc=-sigtc/(fac*fac)
6568 C Following variable is sigma(t_c)**(-2)
6569 sigcsq=sigcsq*sigcsq
6571 sig0inv=1.0D0/sig0i**2
6572 delthec=thetai-thet_pred_mean
6573 delthe0=thetai-theta0i
6574 term1=-0.5D0*sigcsq*delthec*delthec
6575 term2=-0.5D0*sig0inv*delthe0*delthe0
6576 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
6577 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6578 C NaNs in taking the logarithm. We extract the largest exponent which is added
6579 C to the energy (this being the log of the distribution) at the end of energy
6580 C term evaluation for this virtual-bond angle.
6581 if (term1.gt.term2) then
6583 term2=dexp(term2-termm)
6587 term1=dexp(term1-termm)
6590 C The ratio between the gamma-independent and gamma-dependent lobes of
6591 C the distribution is a Gaussian function of thet_pred_mean too.
6592 diffak=gthet(2,it)-thet_pred_mean
6593 ratak=diffak/gthet(3,it)**2
6594 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6595 C Let's differentiate it in thet_pred_mean NOW.
6597 C Now put together the distribution terms to make complete distribution.
6598 termexp=term1+ak*term2
6599 termpre=sigc+ak*sig0i
6600 C Contribution of the bending energy from this theta is just the -log of
6601 C the sum of the contributions from the two lobes and the pre-exponential
6602 C factor. Simple enough, isn't it?
6603 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6604 C write (iout,*) 'termexp',termexp,termm,termpre,i
6605 C NOW the derivatives!!!
6606 C 6/6/97 Take into account the deformation.
6607 E_theta=(delthec*sigcsq*term1
6608 & +ak*delthe0*sig0inv*term2)/termexp
6609 E_tc=((sigtc+aktc*sig0i)/termpre
6610 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
6611 & aktc*term2)/termexp)
6614 c-----------------------------------------------------------------------------
6615 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
6616 implicit real*8 (a-h,o-z)
6617 include 'DIMENSIONS'
6618 include 'COMMON.LOCAL'
6619 include 'COMMON.IOUNITS'
6620 common /calcthet/ term1,term2,termm,diffak,ratak,
6621 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6622 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6623 delthec=thetai-thet_pred_mean
6624 delthe0=thetai-theta0i
6625 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
6626 t3 = thetai-thet_pred_mean
6630 t14 = t12+t6*sigsqtc
6632 t21 = thetai-theta0i
6638 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
6639 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
6640 & *(-t12*t9-ak*sig0inv*t27)
6644 C--------------------------------------------------------------------------
6645 subroutine ebend(etheta,ethetacnstr)
6647 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6648 C angles gamma and its derivatives in consecutive thetas and gammas.
6649 C ab initio-derived potentials from
6650 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6652 implicit real*8 (a-h,o-z)
6653 include 'DIMENSIONS'
6654 include 'COMMON.LOCAL'
6655 include 'COMMON.GEO'
6656 include 'COMMON.INTERACT'
6657 include 'COMMON.DERIV'
6658 include 'COMMON.VAR'
6659 include 'COMMON.CHAIN'
6660 include 'COMMON.IOUNITS'
6661 include 'COMMON.NAMES'
6662 include 'COMMON.FFIELD'
6663 include 'COMMON.CONTROL'
6664 include 'COMMON.TORCNSTR'
6665 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
6666 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
6667 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
6668 & sinph1ph2(maxdouble,maxdouble)
6669 logical lprn /.false./, lprn1 /.false./
6671 do i=ithet_start,ithet_end
6672 c print *,i,itype(i-1),itype(i),itype(i-2)
6673 C if (itype(i-1).eq.ntyp1) cycle
6674 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6675 & .or.itype(i).eq.ntyp1) cycle
6676 C print *,i,theta(i)
6677 if (iabs(itype(i+1)).eq.20) iblock=2
6678 if (iabs(itype(i+1)).ne.20) iblock=1
6682 theti2=0.5d0*theta(i)
6683 ityp2=ithetyp((itype(i-1)))
6685 coskt(k)=dcos(k*theti2)
6686 sinkt(k)=dsin(k*theti2)
6689 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
6692 if (phii.ne.phii) phii=150.0
6696 ityp1=ithetyp((itype(i-2)))
6697 C propagation of chirality for glycine type
6699 cosph1(k)=dcos(k*phii)
6700 sinph1(k)=dsin(k*phii)
6705 ityp1=ithetyp((itype(i-2)))
6710 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6713 if (phii1.ne.phii1) phii1=150.0
6718 ityp3=ithetyp((itype(i)))
6720 cosph2(k)=dcos(k*phii1)
6721 sinph2(k)=dsin(k*phii1)
6725 ityp3=ithetyp((itype(i)))
6731 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
6734 ccl=cosph1(l)*cosph2(k-l)
6735 ssl=sinph1(l)*sinph2(k-l)
6736 scl=sinph1(l)*cosph2(k-l)
6737 csl=cosph1(l)*sinph2(k-l)
6738 cosph1ph2(l,k)=ccl-ssl
6739 cosph1ph2(k,l)=ccl+ssl
6740 sinph1ph2(l,k)=scl+csl
6741 sinph1ph2(k,l)=scl-csl
6745 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
6746 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6747 write (iout,*) "coskt and sinkt"
6749 write (iout,*) k,coskt(k),sinkt(k)
6753 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6754 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
6757 & write (iout,*) "k",k,"
6758 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
6759 & " ethetai",ethetai
6762 write (iout,*) "cosph and sinph"
6764 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6766 write (iout,*) "cosph1ph2 and sinph2ph2"
6769 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6770 & sinph1ph2(l,k),sinph1ph2(k,l)
6773 write(iout,*) "ethetai",ethetai
6778 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
6779 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
6780 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
6781 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6782 ethetai=ethetai+sinkt(m)*aux
6783 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6784 dephii=dephii+k*sinkt(m)*(
6785 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
6786 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6787 dephii1=dephii1+k*sinkt(m)*(
6788 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
6789 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6791 & write (iout,*) "m",m," k",k," bbthet",
6792 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
6793 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
6794 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
6795 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6796 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6799 C print *,"cosph1", (cosph1(k), k=1,nsingle)
6800 C print *,"cosph2", (cosph2(k), k=1,nsingle)
6801 C print *,"sinph1", (sinph1(k), k=1,nsingle)
6802 C print *,"sinph2", (sinph2(k), k=1,nsingle)
6804 & write(iout,*) "ethetai",ethetai
6805 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6809 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6810 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
6811 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6812 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6813 ethetai=ethetai+sinkt(m)*aux
6814 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6815 dephii=dephii+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))
6820 dephii1=dephii1+(k-l)*sinkt(m)*(
6821 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6822 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6823 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
6824 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6826 write (iout,*) "m",m," k",k," l",l," ffthet",
6827 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6828 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
6829 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6830 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
6831 & " ethetai",ethetai
6832 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6833 & cosph1ph2(k,l)*sinkt(m),
6834 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6843 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6844 & i,theta(i)*rad2deg,phii*rad2deg,
6845 & phii1*rad2deg,ethetai
6847 etheta=etheta+ethetai
6848 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6849 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6850 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
6854 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6855 do i=ithetaconstr_start,ithetaconstr_end
6856 itheta=itheta_constr(i)
6857 thetiii=theta(itheta)
6858 difi=pinorm(thetiii-theta_constr0(i))
6859 if (difi.gt.theta_drange(i)) then
6860 difi=difi-theta_drange(i)
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
6864 else if (difi.lt.-drange(i)) then
6866 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6867 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6868 & +for_thet_constr(i)*difi**3
6872 if (energy_dec) then
6873 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6874 & i,itheta,rad2deg*thetiii,
6875 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6876 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6877 & gloc(itheta+nphi-2,icg)
6885 c-----------------------------------------------------------------------------
6886 subroutine esc(escloc)
6887 C Calculate the local energy of a side chain and its derivatives in the
6888 C corresponding virtual-bond valence angles THETA and the spherical angles
6890 implicit real*8 (a-h,o-z)
6891 include 'DIMENSIONS'
6892 include 'COMMON.GEO'
6893 include 'COMMON.LOCAL'
6894 include 'COMMON.VAR'
6895 include 'COMMON.INTERACT'
6896 include 'COMMON.DERIV'
6897 include 'COMMON.CHAIN'
6898 include 'COMMON.IOUNITS'
6899 include 'COMMON.NAMES'
6900 include 'COMMON.FFIELD'
6901 include 'COMMON.CONTROL'
6902 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6903 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6904 common /sccalc/ time11,time12,time112,theti,it,nlobit
6907 c write (iout,'(a)') 'ESC'
6908 do i=loc_start,loc_end
6910 if (it.eq.ntyp1) cycle
6911 if (it.eq.10) goto 1
6912 nlobit=nlob(iabs(it))
6913 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6914 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6915 theti=theta(i+1)-pipol
6920 if (x(2).gt.pi-delta) then
6924 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6926 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6927 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6929 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6930 & ddersc0(1),dersc(1))
6931 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6932 & ddersc0(3),dersc(3))
6934 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6936 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6937 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6938 & dersc0(2),esclocbi,dersc02)
6939 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6941 call splinthet(x(2),0.5d0*delta,ss,ssd)
6946 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6948 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6949 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6951 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6953 c write (iout,*) escloci
6954 else if (x(2).lt.delta) then
6958 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6960 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6961 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6963 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6964 & ddersc0(1),dersc(1))
6965 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6966 & ddersc0(3),dersc(3))
6968 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6970 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6971 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6972 & dersc0(2),esclocbi,dersc02)
6973 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6978 call splinthet(x(2),0.5d0*delta,ss,ssd)
6980 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6982 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6983 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6985 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6986 c write (iout,*) escloci
6988 call enesc(x,escloci,dersc,ddummy,.false.)
6991 escloc=escloc+escloci
6992 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6993 & 'escloc',i,escloci
6994 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6996 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6998 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6999 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
7004 C---------------------------------------------------------------------------
7005 subroutine enesc(x,escloci,dersc,ddersc,mixed)
7006 implicit real*8 (a-h,o-z)
7007 include 'DIMENSIONS'
7008 include 'COMMON.GEO'
7009 include 'COMMON.LOCAL'
7010 include 'COMMON.IOUNITS'
7011 common /sccalc/ time11,time12,time112,theti,it,nlobit
7012 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
7013 double precision contr(maxlob,-1:1)
7015 c write (iout,*) 'it=',it,' nlobit=',nlobit
7019 if (mixed) ddersc(j)=0.0d0
7023 C Because of periodicity of the dependence of the SC energy in omega we have
7024 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
7025 C To avoid underflows, first compute & store the exponents.
7033 z(k)=x(k)-censc(k,j,it)
7038 Axk=Axk+gaussc(l,k,j,it)*z(l)
7044 expfac=expfac+Ax(k,j,iii)*z(k)
7052 C As in the case of ebend, we want to avoid underflows in exponentiation and
7053 C subsequent NaNs and INFs in energy calculation.
7054 C Find the largest exponent
7058 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
7062 cd print *,'it=',it,' emin=',emin
7064 C Compute the contribution to SC energy and derivatives
7069 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
7070 if(adexp.ne.adexp) adexp=1.0
7073 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
7075 cd print *,'j=',j,' expfac=',expfac
7076 escloc_i=escloc_i+expfac
7078 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
7082 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
7083 & +gaussc(k,2,j,it))*expfac
7090 dersc(1)=dersc(1)/cos(theti)**2
7091 ddersc(1)=ddersc(1)/cos(theti)**2
7094 escloci=-(dlog(escloc_i)-emin)
7096 dersc(j)=dersc(j)/escloc_i
7100 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
7105 C------------------------------------------------------------------------------
7106 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
7107 implicit real*8 (a-h,o-z)
7108 include 'DIMENSIONS'
7109 include 'COMMON.GEO'
7110 include 'COMMON.LOCAL'
7111 include 'COMMON.IOUNITS'
7112 common /sccalc/ time11,time12,time112,theti,it,nlobit
7113 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
7114 double precision contr(maxlob)
7125 z(k)=x(k)-censc(k,j,it)
7131 Axk=Axk+gaussc(l,k,j,it)*z(l)
7137 expfac=expfac+Ax(k,j)*z(k)
7142 C As in the case of ebend, we want to avoid underflows in exponentiation and
7143 C subsequent NaNs and INFs in energy calculation.
7144 C Find the largest exponent
7147 if (emin.gt.contr(j)) emin=contr(j)
7151 C Compute the contribution to SC energy and derivatives
7155 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
7156 escloc_i=escloc_i+expfac
7158 dersc(k)=dersc(k)+Ax(k,j)*expfac
7160 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
7161 & +gaussc(1,2,j,it))*expfac
7165 dersc(1)=dersc(1)/cos(theti)**2
7166 dersc12=dersc12/cos(theti)**2
7167 escloci=-(dlog(escloc_i)-emin)
7169 dersc(j)=dersc(j)/escloc_i
7171 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
7175 c----------------------------------------------------------------------------------
7176 subroutine esc(escloc)
7177 C Calculate the local energy of a side chain and its derivatives in the
7178 C corresponding virtual-bond valence angles THETA and the spherical angles
7179 C ALPHA and OMEGA derived from AM1 all-atom calculations.
7180 C added by Urszula Kozlowska. 07/11/2007
7182 implicit real*8 (a-h,o-z)
7183 include 'DIMENSIONS'
7184 include 'COMMON.GEO'
7185 include 'COMMON.LOCAL'
7186 include 'COMMON.VAR'
7187 include 'COMMON.SCROT'
7188 include 'COMMON.INTERACT'
7189 include 'COMMON.DERIV'
7190 include 'COMMON.CHAIN'
7191 include 'COMMON.IOUNITS'
7192 include 'COMMON.NAMES'
7193 include 'COMMON.FFIELD'
7194 include 'COMMON.CONTROL'
7195 include 'COMMON.VECTORS'
7196 double precision x_prime(3),y_prime(3),z_prime(3)
7197 & , sumene,dsc_i,dp2_i,x(65),
7198 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
7199 & de_dxx,de_dyy,de_dzz,de_dt
7200 double precision s1_t,s1_6_t,s2_t,s2_6_t
7202 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
7203 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
7204 & dt_dCi(3),dt_dCi1(3)
7205 common /sccalc/ time11,time12,time112,theti,it,nlobit
7208 do i=loc_start,loc_end
7209 if (itype(i).eq.ntyp1) cycle
7210 costtab(i+1) =dcos(theta(i+1))
7211 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
7212 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
7213 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
7214 cosfac2=0.5d0/(1.0d0+costtab(i+1))
7215 cosfac=dsqrt(cosfac2)
7216 sinfac2=0.5d0/(1.0d0-costtab(i+1))
7217 sinfac=dsqrt(sinfac2)
7219 if (it.eq.10) goto 1
7221 C Compute the axes of tghe local cartesian coordinates system; store in
7222 c x_prime, y_prime and z_prime
7229 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
7230 C & dc_norm(3,i+nres)
7232 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
7233 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
7236 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
7239 c write (2,*) "x_prime",(x_prime(j),j=1,3)
7240 c write (2,*) "y_prime",(y_prime(j),j=1,3)
7241 c write (2,*) "z_prime",(z_prime(j),j=1,3)
7242 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
7243 c & " xy",scalar(x_prime(1),y_prime(1)),
7244 c & " xz",scalar(x_prime(1),z_prime(1)),
7245 c & " yy",scalar(y_prime(1),y_prime(1)),
7246 c & " yz",scalar(y_prime(1),z_prime(1)),
7247 c & " zz",scalar(z_prime(1),z_prime(1))
7249 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
7250 C to local coordinate system. Store in xx, yy, zz.
7256 xx = xx + x_prime(j)*dc_norm(j,i+nres)
7257 yy = yy + y_prime(j)*dc_norm(j,i+nres)
7258 zz = zz + z_prime(j)*dc_norm(j,i+nres)
7265 C Compute the energy of the ith side cbain
7267 c write (2,*) "xx",xx," yy",yy," zz",zz
7270 x(j) = sc_parmin(j,it)
7273 Cc diagnostics - remove later
7275 yy1 = dsin(alph(2))*dcos(omeg(2))
7276 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
7277 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
7278 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
7280 C," --- ", xx_w,yy_w,zz_w
7283 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7284 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7286 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7287 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7289 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7290 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7291 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7292 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7293 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7295 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7296 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7297 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7298 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7299 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7301 dsc_i = 0.743d0+x(61)
7303 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7304 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
7305 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7306 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
7307 s1=(1+x(63))/(0.1d0 + dscp1)
7308 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7309 s2=(1+x(65))/(0.1d0 + dscp2)
7310 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7311 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
7312 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
7313 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
7315 c & dscp1,dscp2,sumene
7316 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7317 escloc = escloc + sumene
7318 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
7323 C This section to check the numerical derivatives of the energy of ith side
7324 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
7325 C #define DEBUG in the code to turn it on.
7327 write (2,*) "sumene =",sumene
7331 write (2,*) xx,yy,zz
7332 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7333 de_dxx_num=(sumenep-sumene)/aincr
7335 write (2,*) "xx+ sumene from enesc=",sumenep
7338 write (2,*) xx,yy,zz
7339 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7340 de_dyy_num=(sumenep-sumene)/aincr
7342 write (2,*) "yy+ sumene from enesc=",sumenep
7345 write (2,*) xx,yy,zz
7346 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7347 de_dzz_num=(sumenep-sumene)/aincr
7349 write (2,*) "zz+ sumene from enesc=",sumenep
7350 costsave=cost2tab(i+1)
7351 sintsave=sint2tab(i+1)
7352 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
7353 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
7354 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7355 de_dt_num=(sumenep-sumene)/aincr
7356 write (2,*) " t+ sumene from enesc=",sumenep
7357 cost2tab(i+1)=costsave
7358 sint2tab(i+1)=sintsave
7359 C End of diagnostics section.
7362 C Compute the gradient of esc
7364 c zz=zz*dsign(1.0,dfloat(itype(i)))
7365 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
7366 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
7367 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
7368 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
7369 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
7370 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
7371 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
7372 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
7373 pom1=(sumene3*sint2tab(i+1)+sumene1)
7374 & *(pom_s1/dscp1+pom_s16*dscp1**4)
7375 pom2=(sumene4*cost2tab(i+1)+sumene2)
7376 & *(pom_s2/dscp2+pom_s26*dscp2**4)
7377 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
7378 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
7379 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
7381 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
7382 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
7383 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
7385 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
7386 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
7387 & +(pom1+pom2)*pom_dx
7389 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
7392 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
7393 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
7394 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
7396 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
7397 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
7398 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
7399 & +x(59)*zz**2 +x(60)*xx*zz
7400 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
7401 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
7402 & +(pom1-pom2)*pom_dy
7404 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
7407 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
7408 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
7409 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
7410 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
7411 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
7412 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
7413 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
7414 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
7416 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
7419 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
7420 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
7421 & +pom1*pom_dt1+pom2*pom_dt2
7423 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
7428 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
7429 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
7430 cosfac2xx=cosfac2*xx
7431 sinfac2yy=sinfac2*yy
7433 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
7435 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
7437 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
7438 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
7439 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
7440 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
7441 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
7442 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
7443 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
7444 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
7445 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
7446 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
7450 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
7451 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
7452 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
7453 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
7456 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
7457 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
7458 dZZ_XYZ(k)=vbld_inv(i+nres)*
7459 & (z_prime(k)-zz*dC_norm(k,i+nres))
7461 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
7462 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
7466 dXX_Ctab(k,i)=dXX_Ci(k)
7467 dXX_C1tab(k,i)=dXX_Ci1(k)
7468 dYY_Ctab(k,i)=dYY_Ci(k)
7469 dYY_C1tab(k,i)=dYY_Ci1(k)
7470 dZZ_Ctab(k,i)=dZZ_Ci(k)
7471 dZZ_C1tab(k,i)=dZZ_Ci1(k)
7472 dXX_XYZtab(k,i)=dXX_XYZ(k)
7473 dYY_XYZtab(k,i)=dYY_XYZ(k)
7474 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
7478 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
7479 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
7480 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
7481 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
7482 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
7484 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
7485 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
7486 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
7487 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
7488 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
7489 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
7490 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
7491 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
7493 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
7494 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
7496 C to check gradient call subroutine check_grad
7502 c------------------------------------------------------------------------------
7503 double precision function enesc(x,xx,yy,zz,cost2,sint2)
7505 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
7506 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
7507 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7508 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7510 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7511 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7513 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7514 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7515 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7516 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7517 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7519 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7520 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7521 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7522 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7523 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7525 dsc_i = 0.743d0+x(61)
7527 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7528 & *(xx*cost2+yy*sint2))
7529 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7530 & *(xx*cost2-yy*sint2))
7531 s1=(1+x(63))/(0.1d0 + dscp1)
7532 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7533 s2=(1+x(65))/(0.1d0 + dscp2)
7534 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7535 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
7536 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
7541 c------------------------------------------------------------------------------
7542 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
7544 C This procedure calculates two-body contact function g(rij) and its derivative:
7547 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
7550 C where x=(rij-r0ij)/delta
7552 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
7555 double precision rij,r0ij,eps0ij,fcont,fprimcont
7556 double precision x,x2,x4,delta
7560 if (x.lt.-1.0D0) then
7563 else if (x.le.1.0D0) then
7566 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
7567 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7574 c------------------------------------------------------------------------------
7575 subroutine splinthet(theti,delta,ss,ssder)
7576 implicit real*8 (a-h,o-z)
7577 include 'DIMENSIONS'
7578 include 'COMMON.VAR'
7579 include 'COMMON.GEO'
7582 if (theti.gt.pipol) then
7583 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7585 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7590 c------------------------------------------------------------------------------
7591 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7593 double precision x,x0,delta,f0,f1,fprim0,f,fprim
7594 double precision ksi,ksi2,ksi3,a1,a2,a3
7595 a1=fprim0*delta/(f1-f0)
7601 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7602 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7605 c------------------------------------------------------------------------------
7606 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7608 double precision x,x0,delta,f0x,f1x,fprim0x,fx
7609 double precision ksi,ksi2,ksi3,a1,a2,a3
7614 a2=3*(f1x-f0x)-2*fprim0x*delta
7615 a3=fprim0x*delta-2*(f1x-f0x)
7616 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7619 C-----------------------------------------------------------------------------
7621 C-----------------------------------------------------------------------------
7622 subroutine etor(etors,edihcnstr)
7623 implicit real*8 (a-h,o-z)
7624 include 'DIMENSIONS'
7625 include 'COMMON.VAR'
7626 include 'COMMON.GEO'
7627 include 'COMMON.LOCAL'
7628 include 'COMMON.TORSION'
7629 include 'COMMON.INTERACT'
7630 include 'COMMON.DERIV'
7631 include 'COMMON.CHAIN'
7632 include 'COMMON.NAMES'
7633 include 'COMMON.IOUNITS'
7634 include 'COMMON.FFIELD'
7635 include 'COMMON.TORCNSTR'
7636 include 'COMMON.CONTROL'
7638 C Set lprn=.true. for debugging
7642 do i=iphi_start,iphi_end
7644 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7645 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7646 itori=itortyp(itype(i-2))
7647 itori1=itortyp(itype(i-1))
7650 C Proline-Proline pair is a special case...
7651 if (itori.eq.3 .and. itori1.eq.3) then
7652 if (phii.gt.-dwapi3) then
7654 fac=1.0D0/(1.0D0-cosphi)
7655 etorsi=v1(1,3,3)*fac
7656 etorsi=etorsi+etorsi
7657 etors=etors+etorsi-v1(1,3,3)
7658 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
7659 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7662 v1ij=v1(j+1,itori,itori1)
7663 v2ij=v2(j+1,itori,itori1)
7666 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7667 if (energy_dec) etors_ii=etors_ii+
7668 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7669 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7673 v1ij=v1(j,itori,itori1)
7674 v2ij=v2(j,itori,itori1)
7677 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7678 if (energy_dec) etors_ii=etors_ii+
7679 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7680 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7683 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7686 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7687 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7688 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7689 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7690 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7692 ! 6/20/98 - dihedral angle constraints
7695 itori=idih_constr(i)
7698 if (difi.gt.drange(i)) then
7700 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7701 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7702 else if (difi.lt.-drange(i)) then
7704 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
7705 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7707 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
7708 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7710 ! write (iout,*) 'edihcnstr',edihcnstr
7713 c------------------------------------------------------------------------------
7714 subroutine etor_d(etors_d)
7718 c----------------------------------------------------------------------------
7720 subroutine etor(etors,edihcnstr)
7721 implicit real*8 (a-h,o-z)
7722 include 'DIMENSIONS'
7723 include 'COMMON.VAR'
7724 include 'COMMON.GEO'
7725 include 'COMMON.LOCAL'
7726 include 'COMMON.TORSION'
7727 include 'COMMON.INTERACT'
7728 include 'COMMON.DERIV'
7729 include 'COMMON.CHAIN'
7730 include 'COMMON.NAMES'
7731 include 'COMMON.IOUNITS'
7732 include 'COMMON.FFIELD'
7733 include 'COMMON.TORCNSTR'
7734 include 'COMMON.CONTROL'
7736 C Set lprn=.true. for debugging
7740 do i=iphi_start,iphi_end
7741 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7742 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7743 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7744 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7745 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7746 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7747 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7748 C For introducing the NH3+ and COO- group please check the etor_d for reference
7751 if (iabs(itype(i)).eq.20) then
7756 itori=itortyp(itype(i-2))
7757 itori1=itortyp(itype(i-1))
7760 C Regular cosine and sine terms
7761 do j=1,nterm(itori,itori1,iblock)
7762 v1ij=v1(j,itori,itori1,iblock)
7763 v2ij=v2(j,itori,itori1,iblock)
7766 etors=etors+v1ij*cosphi+v2ij*sinphi
7767 if (energy_dec) etors_ii=etors_ii+
7768 & v1ij*cosphi+v2ij*sinphi
7769 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7773 C E = SUM ----------------------------------- - v1
7774 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7776 cosphi=dcos(0.5d0*phii)
7777 sinphi=dsin(0.5d0*phii)
7778 do j=1,nlor(itori,itori1,iblock)
7779 vl1ij=vlor1(j,itori,itori1)
7780 vl2ij=vlor2(j,itori,itori1)
7781 vl3ij=vlor3(j,itori,itori1)
7782 pom=vl2ij*cosphi+vl3ij*sinphi
7783 pom1=1.0d0/(pom*pom+1.0d0)
7784 etors=etors+vl1ij*pom1
7785 if (energy_dec) etors_ii=etors_ii+
7788 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7790 C Subtract the constant term
7791 etors=etors-v0(itori,itori1,iblock)
7792 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7793 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
7795 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7796 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7797 & (v1(j,itori,itori1,iblock),j=1,6),
7798 & (v2(j,itori,itori1,iblock),j=1,6)
7799 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7800 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7802 ! 6/20/98 - dihedral angle constraints
7804 c do i=1,ndih_constr
7805 do i=idihconstr_start,idihconstr_end
7806 itori=idih_constr(i)
7808 difi=pinorm(phii-phi0(i))
7809 if (difi.gt.drange(i)) then
7811 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7812 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7813 else if (difi.lt.-drange(i)) then
7815 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7816 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7820 if (energy_dec) then
7821 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
7822 & i,itori,rad2deg*phii,
7823 & rad2deg*phi0(i), rad2deg*drange(i),
7824 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
7827 cd write (iout,*) 'edihcnstr',edihcnstr
7830 c----------------------------------------------------------------------------
7831 subroutine etor_d(etors_d)
7832 C 6/23/01 Compute double torsional energy
7833 implicit real*8 (a-h,o-z)
7834 include 'DIMENSIONS'
7835 include 'COMMON.VAR'
7836 include 'COMMON.GEO'
7837 include 'COMMON.LOCAL'
7838 include 'COMMON.TORSION'
7839 include 'COMMON.INTERACT'
7840 include 'COMMON.DERIV'
7841 include 'COMMON.CHAIN'
7842 include 'COMMON.NAMES'
7843 include 'COMMON.IOUNITS'
7844 include 'COMMON.FFIELD'
7845 include 'COMMON.TORCNSTR'
7847 C Set lprn=.true. for debugging
7851 c write(iout,*) "a tu??"
7852 do i=iphid_start,iphid_end
7853 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7854 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7855 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7856 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7857 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7858 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7859 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7860 & (itype(i+1).eq.ntyp1)) cycle
7861 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7862 itori=itortyp(itype(i-2))
7863 itori1=itortyp(itype(i-1))
7864 itori2=itortyp(itype(i))
7870 if (iabs(itype(i+1)).eq.20) iblock=2
7871 C Iblock=2 Proline type
7872 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7873 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7874 C if (itype(i+1).eq.ntyp1) iblock=3
7875 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7876 C IS or IS NOT need for this
7877 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7878 C is (itype(i-3).eq.ntyp1) ntblock=2
7879 C ntblock is N-terminal blocking group
7881 C Regular cosine and sine terms
7882 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7883 C Example of changes for NH3+ blocking group
7884 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7885 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7886 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7887 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7888 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7889 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7890 cosphi1=dcos(j*phii)
7891 sinphi1=dsin(j*phii)
7892 cosphi2=dcos(j*phii1)
7893 sinphi2=dsin(j*phii1)
7894 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7895 & v2cij*cosphi2+v2sij*sinphi2
7896 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7897 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7899 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7901 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7902 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7903 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7904 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7905 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7906 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7907 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7908 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7909 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7910 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7911 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7912 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7913 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7914 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7917 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7918 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7923 C----------------------------------------------------------------------------------
7924 C The rigorous attempt to derive energy function
7925 subroutine etor_kcc(etors,edihcnstr)
7926 implicit real*8 (a-h,o-z)
7927 include 'DIMENSIONS'
7928 include 'COMMON.VAR'
7929 include 'COMMON.GEO'
7930 include 'COMMON.LOCAL'
7931 include 'COMMON.TORSION'
7932 include 'COMMON.INTERACT'
7933 include 'COMMON.DERIV'
7934 include 'COMMON.CHAIN'
7935 include 'COMMON.NAMES'
7936 include 'COMMON.IOUNITS'
7937 include 'COMMON.FFIELD'
7938 include 'COMMON.TORCNSTR'
7939 include 'COMMON.CONTROL'
7941 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
7942 C Set lprn=.true. for debugging
7945 C print *,"wchodze kcc"
7946 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
7947 if (tor_mode.ne.2) then
7950 do i=iphi_start,iphi_end
7951 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7952 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7953 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7954 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7955 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7956 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7957 itori=itortyp_kcc(itype(i-2))
7958 itori1=itortyp_kcc(itype(i-1))
7963 sumnonchebyshev=0.0d0
7965 C to avoid multiple devision by 2
7966 c theti22=0.5d0*theta(i)
7967 C theta 12 is the theta_1 /2
7968 C theta 22 is theta_2 /2
7969 c theti12=0.5d0*theta(i-1)
7970 C and appropriate sinus function
7971 sinthet1=dsin(theta(i-1))
7972 sinthet2=dsin(theta(i))
7973 costhet1=dcos(theta(i-1))
7974 costhet2=dcos(theta(i))
7975 c Cosines of halves thetas
7976 costheti12=0.5d0*(1.0d0+costhet1)
7977 costheti22=0.5d0*(1.0d0+costhet2)
7978 C to speed up lets store its mutliplication
7979 sint1t2=sinthet2*sinthet1
7981 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
7982 C +d_n*sin(n*gamma)) *
7983 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
7984 C we have two sum 1) Non-Chebyshev which is with n and gamma
7986 do j=1,nterm_kcc(itori,itori1)
7988 nval=nterm_kcc_Tb(itori,itori1)
7989 v1ij=v1_kcc(j,itori,itori1)
7990 v2ij=v2_kcc(j,itori,itori1)
7991 c write (iout,*) "i",i," j",j," v1",v1ij," v2",v2ij
7992 C v1ij is c_n and d_n in euation above
7996 sint1t2n=sint1t2n*sint1t2
7997 sumth1tyb1=tschebyshev(1,nval,v11_chyb(1,j,itori,itori1),
7999 gradth1tyb1=-0.5d0*sinthet1*gradtschebyshev(0,nval-1,
8000 & v11_chyb(1,j,itori,itori1),costheti12)
8001 c write (iout,*) "v11",(v11_chyb(k,j,itori,itori1),k=1,nval),
8002 c & " sumth1tyb1",sumth1tyb1," gradth1tyb1",gradth1tyb1
8003 sumth2tyb1=tschebyshev(1,nval,v21_chyb(1,j,itori,itori1),
8005 gradth2tyb1=-0.5d0*sinthet2*gradtschebyshev(0,nval-1,
8006 & v21_chyb(1,j,itori,itori1),costheti22)
8007 c write (iout,*) "v21",(v21_chyb(k,j,itori,itori1),k=1,nval),
8008 c & " sumth2tyb1",sumth2tyb1," gradth2tyb1",gradth2tyb1
8009 sumth1tyb2=tschebyshev(1,nval,v12_chyb(1,j,itori,itori1),
8011 gradth1tyb2=-0.5d0*sinthet1*gradtschebyshev(0,nval-1,
8012 & v12_chyb(1,j,itori,itori1),costheti12)
8013 c write (iout,*) "v12",(v12_chyb(k,j,itori,itori1),k=1,nval),
8014 c & " sumth1tyb2",sumth1tyb2," gradth1tyb2",gradth1tyb2
8015 sumth2tyb2=tschebyshev(1,nval,v22_chyb(1,j,itori,itori1),
8017 gradth2tyb2=-0.5d0*sinthet2*gradtschebyshev(0,nval-1,
8018 & v22_chyb(1,j,itori,itori1),costheti22)
8019 c write (iout,*) "v22",(v22_chyb(k,j,itori,itori1),k=1,nval),
8020 c & " sumth2tyb2",sumth2tyb2," gradth2tyb2",gradth2tyb2
8021 C etors=etors+sint1t2n*(v1ij*cosphi+v2ij*sinphi)
8022 C if (energy_dec) etors_ii=etors_ii+
8023 C & v1ij*cosphi+v2ij*sinphi
8024 C glocig is the gradient local i site in gamma
8025 actval1=v1ij*cosphi*(1.0d0+sumth1tyb1+sumth2tyb1)
8026 actval2=v2ij*sinphi*(1.0d0+sumth1tyb2+sumth2tyb2)
8027 etori=etori+sint1t2n*(actval1+actval2)
8029 & j*sint1t2n*(v2ij*cosphi*(1.0d0+sumth1tyb2+sumth2tyb2)
8030 & -v1ij*sinphi*(1.0d0+sumth1tyb1+sumth2tyb1))
8031 C now gradient over theta_1
8033 & j*sint1t2n1*costhet1*sinthet2*(actval1+actval2)+
8034 & sint1t2n*(v1ij*cosphi*gradth1tyb1+v2ij*sinphi*gradth1tyb2)
8036 & j*sint1t2n1*sinthet1*costhet2*(actval1+actval2)+
8037 & sint1t2n*(v1ij*cosphi*gradth2tyb1+v2ij*sinphi*gradth2tyb2)
8039 C now the Czebyshev polinominal sum
8040 c do k=1,nterm_kcc_Tb(itori,itori1)
8041 c thybt1(k)=v1_chyb(k,j,itori,itori1)
8042 c thybt2(k)=v2_chyb(k,j,itori,itori1)
8046 C print *, sumth1thyb, gradthybt1, sumth2thyb, gradthybt2,
8048 C & (0,nterm_kcc_Tb(itori,itori1)-1,thybt2(1),
8049 C & dcos(theti22)**2),
8052 C now overal sumation
8053 C print *,"sumnon", sumnonchebyshev,sumth1thyb+sumth2thyb
8056 C derivative over gamma
8057 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
8058 C derivative over theta1
8059 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
8060 C now derivative over theta2
8061 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
8063 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
8064 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
8066 C gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
8067 ! 6/20/98 - dihedral angle constraints
8068 if (tor_mode.ne.2) then
8070 c do i=1,ndih_constr
8071 do i=idihconstr_start,idihconstr_end
8072 itori=idih_constr(i)
8074 difi=pinorm(phii-phi0(i))
8075 if (difi.gt.drange(i)) then
8077 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
8078 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
8079 else if (difi.lt.-drange(i)) then
8081 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
8082 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
8091 C The rigorous attempt to derive energy function
8092 subroutine ebend_kcc(etheta,ethetacnstr)
8094 implicit real*8 (a-h,o-z)
8095 include 'DIMENSIONS'
8096 include 'COMMON.VAR'
8097 include 'COMMON.GEO'
8098 include 'COMMON.LOCAL'
8099 include 'COMMON.TORSION'
8100 include 'COMMON.INTERACT'
8101 include 'COMMON.DERIV'
8102 include 'COMMON.CHAIN'
8103 include 'COMMON.NAMES'
8104 include 'COMMON.IOUNITS'
8105 include 'COMMON.FFIELD'
8106 include 'COMMON.TORCNSTR'
8107 include 'COMMON.CONTROL'
8109 double precision thybt1(maxtermkcc)
8110 C Set lprn=.true. for debugging
8113 C print *,"wchodze kcc"
8114 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
8115 if (tor_mode.ne.2) etheta=0.0D0
8116 do i=ithet_start,ithet_end
8117 c print *,i,itype(i-1),itype(i),itype(i-2)
8118 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
8119 & .or.itype(i).eq.ntyp1) cycle
8120 iti=itortyp_kcc(itype(i-1))
8121 sinthet=dsin(theta(i)/2.0d0)
8122 costhet=dcos(theta(i)/2.0d0)
8123 do j=1,nbend_kcc_Tb(iti)
8124 thybt1(j)=v1bend_chyb(j,iti)
8126 sumth1thyb=tschebyshev
8127 & (1,nbend_kcc_Tb(iti),thybt1(1),costhet)
8128 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
8130 ihelp=nbend_kcc_Tb(iti)-1
8131 gradthybt1=gradtschebyshev
8132 & (0,ihelp,thybt1(1),costhet)
8133 etheta=etheta+sumth1thyb
8134 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
8135 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*
8136 & gradthybt1*sinthet*(-0.5d0)
8138 if (tor_mode.ne.2) then
8140 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
8141 do i=ithetaconstr_start,ithetaconstr_end
8142 itheta=itheta_constr(i)
8143 thetiii=theta(itheta)
8144 difi=pinorm(thetiii-theta_constr0(i))
8145 if (difi.gt.theta_drange(i)) then
8146 difi=difi-theta_drange(i)
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
8150 else if (difi.lt.-drange(i)) then
8152 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
8153 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
8154 & +for_thet_constr(i)*difi**3
8158 if (energy_dec) then
8159 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
8160 & i,itheta,rad2deg*thetiii,
8161 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
8162 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
8163 & gloc(itheta+nphi-2,icg)
8169 c------------------------------------------------------------------------------
8170 subroutine eback_sc_corr(esccor)
8171 c 7/21/2007 Correlations between the backbone-local and side-chain-local
8172 c conformational states; temporarily implemented as differences
8173 c between UNRES torsional potentials (dependent on three types of
8174 c residues) and the torsional potentials dependent on all 20 types
8175 c of residues computed from AM1 energy surfaces of terminally-blocked
8176 c amino-acid residues.
8177 implicit real*8 (a-h,o-z)
8178 include 'DIMENSIONS'
8179 include 'COMMON.VAR'
8180 include 'COMMON.GEO'
8181 include 'COMMON.LOCAL'
8182 include 'COMMON.TORSION'
8183 include 'COMMON.SCCOR'
8184 include 'COMMON.INTERACT'
8185 include 'COMMON.DERIV'
8186 include 'COMMON.CHAIN'
8187 include 'COMMON.NAMES'
8188 include 'COMMON.IOUNITS'
8189 include 'COMMON.FFIELD'
8190 include 'COMMON.CONTROL'
8192 C Set lprn=.true. for debugging
8195 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
8197 do i=itau_start,itau_end
8198 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
8200 isccori=isccortyp(itype(i-2))
8201 isccori1=isccortyp(itype(i-1))
8202 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
8204 do intertyp=1,3 !intertyp
8205 cc Added 09 May 2012 (Adasko)
8206 cc Intertyp means interaction type of backbone mainchain correlation:
8207 c 1 = SC...Ca...Ca...Ca
8208 c 2 = Ca...Ca...Ca...SC
8209 c 3 = SC...Ca...Ca...SCi
8211 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
8212 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
8213 & (itype(i-1).eq.ntyp1)))
8214 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
8215 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
8216 & .or.(itype(i).eq.ntyp1)))
8217 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
8218 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
8219 & (itype(i-3).eq.ntyp1)))) cycle
8220 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
8221 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
8223 do j=1,nterm_sccor(isccori,isccori1)
8224 v1ij=v1sccor(j,intertyp,isccori,isccori1)
8225 v2ij=v2sccor(j,intertyp,isccori,isccori1)
8226 cosphi=dcos(j*tauangle(intertyp,i))
8227 sinphi=dsin(j*tauangle(intertyp,i))
8228 esccor=esccor+v1ij*cosphi+v2ij*sinphi
8229 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
8231 if (energy_dec) write(iout,'(a9,2i4,f8.3,3i4)') "esccor",i,j,
8234 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
8235 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
8237 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
8238 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
8239 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
8240 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
8241 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
8247 c----------------------------------------------------------------------------
8248 subroutine multibody(ecorr)
8249 C This subroutine calculates multi-body contributions to energy following
8250 C the idea of Skolnick et al. If side chains I and J make a contact and
8251 C at the same time side chains I+1 and J+1 make a contact, an extra
8252 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
8253 implicit real*8 (a-h,o-z)
8254 include 'DIMENSIONS'
8255 include 'COMMON.IOUNITS'
8256 include 'COMMON.DERIV'
8257 include 'COMMON.INTERACT'
8258 include 'COMMON.CONTACTS'
8259 double precision gx(3),gx1(3)
8262 C Set lprn=.true. for debugging
8266 write (iout,'(a)') 'Contact function values:'
8268 write (iout,'(i2,20(1x,i2,f10.5))')
8269 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
8284 num_conti=num_cont(i)
8285 num_conti1=num_cont(i1)
8290 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
8291 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8292 cd & ' ishift=',ishift
8293 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
8294 C The system gains extra energy.
8295 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
8296 endif ! j1==j+-ishift
8305 c------------------------------------------------------------------------------
8306 double precision function esccorr(i,j,k,l,jj,kk)
8307 implicit real*8 (a-h,o-z)
8308 include 'DIMENSIONS'
8309 include 'COMMON.IOUNITS'
8310 include 'COMMON.DERIV'
8311 include 'COMMON.INTERACT'
8312 include 'COMMON.CONTACTS'
8313 include 'COMMON.SHIELD'
8314 double precision gx(3),gx1(3)
8319 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
8320 C Calculate the multi-body contribution to energy.
8321 C Calculate multi-body contributions to the gradient.
8322 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
8323 cd & k,l,(gacont(m,kk,k),m=1,3)
8325 gx(m) =ekl*gacont(m,jj,i)
8326 gx1(m)=eij*gacont(m,kk,k)
8327 gradxorr(m,i)=gradxorr(m,i)-gx(m)
8328 gradxorr(m,j)=gradxorr(m,j)+gx(m)
8329 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
8330 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
8334 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
8339 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
8345 c------------------------------------------------------------------------------
8346 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
8347 C This subroutine calculates multi-body contributions to hydrogen-bonding
8348 implicit real*8 (a-h,o-z)
8349 include 'DIMENSIONS'
8350 include 'COMMON.IOUNITS'
8353 parameter (max_cont=maxconts)
8354 parameter (max_dim=26)
8355 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8356 double precision zapas(max_dim,maxconts,max_fg_procs),
8357 & zapas_recv(max_dim,maxconts,max_fg_procs)
8358 common /przechowalnia/ zapas
8359 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8360 & status_array(MPI_STATUS_SIZE,maxconts*2)
8362 include 'COMMON.SETUP'
8363 include 'COMMON.FFIELD'
8364 include 'COMMON.DERIV'
8365 include 'COMMON.INTERACT'
8366 include 'COMMON.CONTACTS'
8367 include 'COMMON.CONTROL'
8368 include 'COMMON.LOCAL'
8369 double precision gx(3),gx1(3),time00
8372 C Set lprn=.true. for debugging
8377 if (nfgtasks.le.1) goto 30
8379 write (iout,'(a)') 'Contact function values before RECEIVE:'
8381 write (iout,'(2i3,50(1x,i2,f5.2))')
8382 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8383 & j=1,num_cont_hb(i))
8387 do i=1,ntask_cont_from
8390 do i=1,ntask_cont_to
8393 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8395 C Make the list of contacts to send to send to other procesors
8396 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
8398 do i=iturn3_start,iturn3_end
8399 c write (iout,*) "make contact list turn3",i," num_cont",
8401 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
8403 do i=iturn4_start,iturn4_end
8404 c write (iout,*) "make contact list turn4",i," num_cont",
8406 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
8410 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8412 do j=1,num_cont_hb(i)
8415 iproc=iint_sent_local(k,jjc,ii)
8416 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8417 if (iproc.gt.0) then
8418 ncont_sent(iproc)=ncont_sent(iproc)+1
8419 nn=ncont_sent(iproc)
8421 zapas(2,nn,iproc)=jjc
8422 zapas(3,nn,iproc)=facont_hb(j,i)
8423 zapas(4,nn,iproc)=ees0p(j,i)
8424 zapas(5,nn,iproc)=ees0m(j,i)
8425 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
8426 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
8427 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
8428 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
8429 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
8430 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
8431 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
8432 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
8433 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
8434 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
8435 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
8436 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
8437 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
8438 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
8439 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
8440 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
8441 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
8442 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
8443 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
8444 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
8445 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
8452 & "Numbers of contacts to be sent to other processors",
8453 & (ncont_sent(i),i=1,ntask_cont_to)
8454 write (iout,*) "Contacts sent"
8455 do ii=1,ntask_cont_to
8457 iproc=itask_cont_to(ii)
8458 write (iout,*) nn," contacts to processor",iproc,
8459 & " of CONT_TO_COMM group"
8461 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8469 CorrelID1=nfgtasks+fg_rank+1
8471 C Receive the numbers of needed contacts from other processors
8472 do ii=1,ntask_cont_from
8473 iproc=itask_cont_from(ii)
8475 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8476 & FG_COMM,req(ireq),IERR)
8478 c write (iout,*) "IRECV ended"
8480 C Send the number of contacts needed by other processors
8481 do ii=1,ntask_cont_to
8482 iproc=itask_cont_to(ii)
8484 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8485 & FG_COMM,req(ireq),IERR)
8487 c write (iout,*) "ISEND ended"
8488 c write (iout,*) "number of requests (nn)",ireq
8491 & call MPI_Waitall(ireq,req,status_array,ierr)
8493 c & "Numbers of contacts to be received from other processors",
8494 c & (ncont_recv(i),i=1,ntask_cont_from)
8498 do ii=1,ntask_cont_from
8499 iproc=itask_cont_from(ii)
8501 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8502 c & " of CONT_TO_COMM group"
8506 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8507 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8508 c write (iout,*) "ireq,req",ireq,req(ireq)
8511 C Send the contacts to processors that need them
8512 do ii=1,ntask_cont_to
8513 iproc=itask_cont_to(ii)
8515 c write (iout,*) nn," contacts to processor",iproc,
8516 c & " of CONT_TO_COMM group"
8519 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8520 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8521 c write (iout,*) "ireq,req",ireq,req(ireq)
8523 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8527 c write (iout,*) "number of requests (contacts)",ireq
8528 c write (iout,*) "req",(req(i),i=1,4)
8531 & call MPI_Waitall(ireq,req,status_array,ierr)
8532 do iii=1,ntask_cont_from
8533 iproc=itask_cont_from(iii)
8536 write (iout,*) "Received",nn," contacts from processor",iproc,
8537 & " of CONT_FROM_COMM group"
8540 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8545 ii=zapas_recv(1,i,iii)
8546 c Flag the received contacts to prevent double-counting
8547 jj=-zapas_recv(2,i,iii)
8548 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8550 nnn=num_cont_hb(ii)+1
8553 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8554 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8555 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8556 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8557 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8558 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8559 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8560 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8561 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8562 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8563 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8564 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8565 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8566 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8567 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8568 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8569 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8570 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8571 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8572 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8573 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8574 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8575 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8576 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8581 write (iout,'(a)') 'Contact function values after receive:'
8583 write (iout,'(2i3,50(1x,i3,f5.2))')
8584 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8585 & j=1,num_cont_hb(i))
8592 write (iout,'(a)') 'Contact function values:'
8594 write (iout,'(2i3,50(1x,i3,f5.2))')
8595 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8596 & j=1,num_cont_hb(i))
8600 C Remove the loop below after debugging !!!
8607 C Calculate the local-electrostatic correlation terms
8608 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8610 num_conti=num_cont_hb(i)
8611 num_conti1=num_cont_hb(i+1)
8618 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8619 c & ' jj=',jj,' kk=',kk
8620 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8621 & .or. j.lt.0 .and. j1.gt.0) .and.
8622 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8623 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8624 C The system gains extra energy.
8625 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8626 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
8627 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
8629 else if (j1.eq.j) then
8630 C Contacts I-J and I-(J+1) occur simultaneously.
8631 C The system loses extra energy.
8632 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8637 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8638 c & ' jj=',jj,' kk=',kk
8640 C Contacts I-J and (I+1)-J occur simultaneously.
8641 C The system loses extra energy.
8642 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8649 c------------------------------------------------------------------------------
8650 subroutine add_hb_contact(ii,jj,itask)
8651 implicit real*8 (a-h,o-z)
8652 include "DIMENSIONS"
8653 include "COMMON.IOUNITS"
8656 parameter (max_cont=maxconts)
8657 parameter (max_dim=26)
8658 include "COMMON.CONTACTS"
8659 double precision zapas(max_dim,maxconts,max_fg_procs),
8660 & zapas_recv(max_dim,maxconts,max_fg_procs)
8661 common /przechowalnia/ zapas
8662 integer i,j,ii,jj,iproc,itask(4),nn
8663 c write (iout,*) "itask",itask
8666 if (iproc.gt.0) then
8667 do j=1,num_cont_hb(ii)
8669 c write (iout,*) "i",ii," j",jj," jjc",jjc
8671 ncont_sent(iproc)=ncont_sent(iproc)+1
8672 nn=ncont_sent(iproc)
8673 zapas(1,nn,iproc)=ii
8674 zapas(2,nn,iproc)=jjc
8675 zapas(3,nn,iproc)=facont_hb(j,ii)
8676 zapas(4,nn,iproc)=ees0p(j,ii)
8677 zapas(5,nn,iproc)=ees0m(j,ii)
8678 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8679 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8680 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8681 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8682 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8683 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8684 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8685 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8686 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8687 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8688 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8689 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8690 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8691 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8692 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8693 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8694 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8695 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8696 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8697 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8698 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8706 c------------------------------------------------------------------------------
8707 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8709 C This subroutine calculates multi-body contributions to hydrogen-bonding
8710 implicit real*8 (a-h,o-z)
8711 include 'DIMENSIONS'
8712 include 'COMMON.IOUNITS'
8715 parameter (max_cont=maxconts)
8716 parameter (max_dim=70)
8717 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8718 double precision zapas(max_dim,maxconts,max_fg_procs),
8719 & zapas_recv(max_dim,maxconts,max_fg_procs)
8720 common /przechowalnia/ zapas
8721 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8722 & status_array(MPI_STATUS_SIZE,maxconts*2)
8724 include 'COMMON.SETUP'
8725 include 'COMMON.FFIELD'
8726 include 'COMMON.DERIV'
8727 include 'COMMON.LOCAL'
8728 include 'COMMON.INTERACT'
8729 include 'COMMON.CONTACTS'
8730 include 'COMMON.CHAIN'
8731 include 'COMMON.CONTROL'
8732 include 'COMMON.SHIELD'
8733 double precision gx(3),gx1(3)
8734 integer num_cont_hb_old(maxres)
8736 double precision eello4,eello5,eelo6,eello_turn6
8737 external eello4,eello5,eello6,eello_turn6
8738 C Set lprn=.true. for debugging
8743 num_cont_hb_old(i)=num_cont_hb(i)
8747 if (nfgtasks.le.1) goto 30
8749 write (iout,'(a)') 'Contact function values before RECEIVE:'
8751 write (iout,'(2i3,50(1x,i2,f5.2))')
8752 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8753 & j=1,num_cont_hb(i))
8757 do i=1,ntask_cont_from
8760 do i=1,ntask_cont_to
8763 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8765 C Make the list of contacts to send to send to other procesors
8766 do i=iturn3_start,iturn3_end
8767 c write (iout,*) "make contact list turn3",i," num_cont",
8769 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8771 do i=iturn4_start,iturn4_end
8772 c write (iout,*) "make contact list turn4",i," num_cont",
8774 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8778 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8780 do j=1,num_cont_hb(i)
8783 iproc=iint_sent_local(k,jjc,ii)
8784 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8785 if (iproc.ne.0) then
8786 ncont_sent(iproc)=ncont_sent(iproc)+1
8787 nn=ncont_sent(iproc)
8789 zapas(2,nn,iproc)=jjc
8790 zapas(3,nn,iproc)=d_cont(j,i)
8794 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8799 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8807 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8818 & "Numbers of contacts to be sent to other processors",
8819 & (ncont_sent(i),i=1,ntask_cont_to)
8820 write (iout,*) "Contacts sent"
8821 do ii=1,ntask_cont_to
8823 iproc=itask_cont_to(ii)
8824 write (iout,*) nn," contacts to processor",iproc,
8825 & " of CONT_TO_COMM group"
8827 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8835 CorrelID1=nfgtasks+fg_rank+1
8837 C Receive the numbers of needed contacts from other processors
8838 do ii=1,ntask_cont_from
8839 iproc=itask_cont_from(ii)
8841 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8842 & FG_COMM,req(ireq),IERR)
8844 c write (iout,*) "IRECV ended"
8846 C Send the number of contacts needed by other processors
8847 do ii=1,ntask_cont_to
8848 iproc=itask_cont_to(ii)
8850 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8851 & FG_COMM,req(ireq),IERR)
8853 c write (iout,*) "ISEND ended"
8854 c write (iout,*) "number of requests (nn)",ireq
8857 & call MPI_Waitall(ireq,req,status_array,ierr)
8859 c & "Numbers of contacts to be received from other processors",
8860 c & (ncont_recv(i),i=1,ntask_cont_from)
8864 do ii=1,ntask_cont_from
8865 iproc=itask_cont_from(ii)
8867 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8868 c & " of CONT_TO_COMM group"
8872 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8873 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8874 c write (iout,*) "ireq,req",ireq,req(ireq)
8877 C Send the contacts to processors that need them
8878 do ii=1,ntask_cont_to
8879 iproc=itask_cont_to(ii)
8881 c write (iout,*) nn," contacts to processor",iproc,
8882 c & " of CONT_TO_COMM group"
8885 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8886 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8887 c write (iout,*) "ireq,req",ireq,req(ireq)
8889 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8893 c write (iout,*) "number of requests (contacts)",ireq
8894 c write (iout,*) "req",(req(i),i=1,4)
8897 & call MPI_Waitall(ireq,req,status_array,ierr)
8898 do iii=1,ntask_cont_from
8899 iproc=itask_cont_from(iii)
8902 write (iout,*) "Received",nn," contacts from processor",iproc,
8903 & " of CONT_FROM_COMM group"
8906 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8911 ii=zapas_recv(1,i,iii)
8912 c Flag the received contacts to prevent double-counting
8913 jj=-zapas_recv(2,i,iii)
8914 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8916 nnn=num_cont_hb(ii)+1
8919 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8923 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8928 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8936 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8945 write (iout,'(a)') 'Contact function values after receive:'
8947 write (iout,'(2i3,50(1x,i3,5f6.3))')
8948 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8949 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8956 write (iout,'(a)') 'Contact function values:'
8958 write (iout,'(2i3,50(1x,i2,5f6.3))')
8959 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8960 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8966 C Remove the loop below after debugging !!!
8973 C Calculate the dipole-dipole interaction energies
8974 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8975 do i=iatel_s,iatel_e+1
8976 num_conti=num_cont_hb(i)
8985 C Calculate the local-electrostatic correlation terms
8986 c write (iout,*) "gradcorr5 in eello5 before loop"
8988 c write (iout,'(i5,3f10.5)')
8989 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8991 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8992 c write (iout,*) "corr loop i",i
8994 num_conti=num_cont_hb(i)
8995 num_conti1=num_cont_hb(i+1)
9002 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
9003 c & ' jj=',jj,' kk=',kk
9004 c if (j1.eq.j+1 .or. j1.eq.j-1) then
9005 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
9006 & .or. j.lt.0 .and. j1.gt.0) .and.
9007 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
9008 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
9009 C The system gains extra energy.
9011 sqd1=dsqrt(d_cont(jj,i))
9012 sqd2=dsqrt(d_cont(kk,i1))
9013 sred_geom = sqd1*sqd2
9014 IF (sred_geom.lt.cutoff_corr) THEN
9015 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
9017 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
9018 cd & ' jj=',jj,' kk=',kk
9019 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
9020 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
9022 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
9023 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
9026 cd write (iout,*) 'sred_geom=',sred_geom,
9027 cd & ' ekont=',ekont,' fprim=',fprimcont,
9028 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
9029 cd write (iout,*) "g_contij",g_contij
9030 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
9031 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
9032 call calc_eello(i,jp,i+1,jp1,jj,kk)
9033 if (wcorr4.gt.0.0d0)
9034 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
9035 CC & *fac_shield(i)**2*fac_shield(j)**2
9036 if (energy_dec.and.wcorr4.gt.0.0d0)
9037 1 write (iout,'(a6,4i5,0pf7.3)')
9038 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
9039 c write (iout,*) "gradcorr5 before eello5"
9041 c write (iout,'(i5,3f10.5)')
9042 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
9044 if (wcorr5.gt.0.0d0)
9045 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
9046 c write (iout,*) "gradcorr5 after eello5"
9048 c write (iout,'(i5,3f10.5)')
9049 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
9051 if (energy_dec.and.wcorr5.gt.0.0d0)
9052 1 write (iout,'(a6,4i5,0pf7.3)')
9053 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
9054 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
9055 cd write(2,*)'ijkl',i,jp,i+1,jp1
9056 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
9057 & .or. wturn6.eq.0.0d0))then
9058 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
9059 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
9060 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
9061 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
9062 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
9063 cd & 'ecorr6=',ecorr6
9064 cd write (iout,'(4e15.5)') sred_geom,
9065 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
9066 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
9067 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
9068 else if (wturn6.gt.0.0d0
9069 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
9070 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
9071 eturn6=eturn6+eello_turn6(i,jj,kk)
9072 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
9073 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
9074 cd write (2,*) 'multibody_eello:eturn6',eturn6
9083 num_cont_hb(i)=num_cont_hb_old(i)
9085 c write (iout,*) "gradcorr5 in eello5"
9087 c write (iout,'(i5,3f10.5)')
9088 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
9092 c------------------------------------------------------------------------------
9093 subroutine add_hb_contact_eello(ii,jj,itask)
9094 implicit real*8 (a-h,o-z)
9095 include "DIMENSIONS"
9096 include "COMMON.IOUNITS"
9099 parameter (max_cont=maxconts)
9100 parameter (max_dim=70)
9101 include "COMMON.CONTACTS"
9102 double precision zapas(max_dim,maxconts,max_fg_procs),
9103 & zapas_recv(max_dim,maxconts,max_fg_procs)
9104 common /przechowalnia/ zapas
9105 integer i,j,ii,jj,iproc,itask(4),nn
9106 c write (iout,*) "itask",itask
9109 if (iproc.gt.0) then
9110 do j=1,num_cont_hb(ii)
9112 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
9114 ncont_sent(iproc)=ncont_sent(iproc)+1
9115 nn=ncont_sent(iproc)
9116 zapas(1,nn,iproc)=ii
9117 zapas(2,nn,iproc)=jjc
9118 zapas(3,nn,iproc)=d_cont(j,ii)
9122 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
9127 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
9135 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
9147 c------------------------------------------------------------------------------
9148 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
9149 implicit real*8 (a-h,o-z)
9150 include 'DIMENSIONS'
9151 include 'COMMON.IOUNITS'
9152 include 'COMMON.DERIV'
9153 include 'COMMON.INTERACT'
9154 include 'COMMON.CONTACTS'
9155 include 'COMMON.SHIELD'
9156 include 'COMMON.CONTROL'
9157 double precision gx(3),gx1(3)
9160 C print *,"wchodze",fac_shield(i),shield_mode
9168 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
9170 C & fac_shield(i)**2*fac_shield(j)**2
9171 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
9172 C Following 4 lines for diagnostics.
9177 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
9178 c & 'Contacts ',i,j,
9179 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
9180 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
9182 C Calculate the multi-body contribution to energy.
9183 C ecorr=ecorr+ekont*ees
9184 C Calculate multi-body contributions to the gradient.
9185 coeffpees0pij=coeffp*ees0pij
9186 coeffmees0mij=coeffm*ees0mij
9187 coeffpees0pkl=coeffp*ees0pkl
9188 coeffmees0mkl=coeffm*ees0mkl
9190 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
9191 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
9192 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
9193 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
9194 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
9195 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
9196 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
9197 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
9198 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
9199 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
9200 & coeffmees0mij*gacontm_hb1(ll,kk,k))
9201 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
9202 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
9203 & coeffmees0mij*gacontm_hb2(ll,kk,k))
9204 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
9205 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
9206 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
9207 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
9208 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
9209 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
9210 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
9211 & coeffmees0mij*gacontm_hb3(ll,kk,k))
9212 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
9213 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
9214 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
9219 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
9220 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
9221 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
9222 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
9227 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
9228 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
9229 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
9230 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
9233 c write (iout,*) "ehbcorr",ekont*ees
9234 C print *,ekont,ees,i,k
9236 C now gradient over shielding
9238 if (shield_mode.gt.0) then
9241 C print *,i,j,fac_shield(i),fac_shield(j),
9242 C &fac_shield(k),fac_shield(l)
9243 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
9244 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
9245 do ilist=1,ishield_list(i)
9246 iresshield=shield_list(ilist,i)
9248 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
9250 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
9252 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
9253 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
9257 do ilist=1,ishield_list(j)
9258 iresshield=shield_list(ilist,j)
9260 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
9262 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
9264 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
9265 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
9270 do ilist=1,ishield_list(k)
9271 iresshield=shield_list(ilist,k)
9273 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
9275 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
9277 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
9278 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
9282 do ilist=1,ishield_list(l)
9283 iresshield=shield_list(ilist,l)
9285 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
9287 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
9289 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
9290 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
9294 C print *,gshieldx(m,iresshield)
9296 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
9297 & grad_shield(m,i)*ehbcorr/fac_shield(i)
9298 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
9299 & grad_shield(m,j)*ehbcorr/fac_shield(j)
9300 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
9301 & grad_shield(m,i)*ehbcorr/fac_shield(i)
9302 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
9303 & grad_shield(m,j)*ehbcorr/fac_shield(j)
9305 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
9306 & grad_shield(m,k)*ehbcorr/fac_shield(k)
9307 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
9308 & grad_shield(m,l)*ehbcorr/fac_shield(l)
9309 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
9310 & grad_shield(m,k)*ehbcorr/fac_shield(k)
9311 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
9312 & grad_shield(m,l)*ehbcorr/fac_shield(l)
9320 C---------------------------------------------------------------------------
9321 subroutine dipole(i,j,jj)
9322 implicit real*8 (a-h,o-z)
9323 include 'DIMENSIONS'
9324 include 'COMMON.IOUNITS'
9325 include 'COMMON.CHAIN'
9326 include 'COMMON.FFIELD'
9327 include 'COMMON.DERIV'
9328 include 'COMMON.INTERACT'
9329 include 'COMMON.CONTACTS'
9330 include 'COMMON.TORSION'
9331 include 'COMMON.VAR'
9332 include 'COMMON.GEO'
9333 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
9335 iti1 = itortyp(itype(i+1))
9336 if (j.lt.nres-1) then
9337 itj1 = itype2loc(itype(j+1))
9342 dipi(iii,1)=Ub2(iii,i)
9343 dipderi(iii)=Ub2der(iii,i)
9344 dipi(iii,2)=b1(iii,i+1)
9345 dipj(iii,1)=Ub2(iii,j)
9346 dipderj(iii)=Ub2der(iii,j)
9347 dipj(iii,2)=b1(iii,j+1)
9351 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
9354 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
9361 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
9365 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
9370 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
9371 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
9373 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
9375 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
9377 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
9382 C---------------------------------------------------------------------------
9383 subroutine calc_eello(i,j,k,l,jj,kk)
9385 C This subroutine computes matrices and vectors needed to calculate
9386 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
9388 implicit real*8 (a-h,o-z)
9389 include 'DIMENSIONS'
9390 include 'COMMON.IOUNITS'
9391 include 'COMMON.CHAIN'
9392 include 'COMMON.DERIV'
9393 include 'COMMON.INTERACT'
9394 include 'COMMON.CONTACTS'
9395 include 'COMMON.TORSION'
9396 include 'COMMON.VAR'
9397 include 'COMMON.GEO'
9398 include 'COMMON.FFIELD'
9399 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
9400 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
9403 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
9404 cd & ' jj=',jj,' kk=',kk
9405 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
9406 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
9407 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
9410 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
9411 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
9414 call transpose2(aa1(1,1),aa1t(1,1))
9415 call transpose2(aa2(1,1),aa2t(1,1))
9418 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
9419 & aa1tder(1,1,lll,kkk))
9420 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
9421 & aa2tder(1,1,lll,kkk))
9425 C parallel orientation of the two CA-CA-CA frames.
9427 iti=itype2loc(itype(i))
9431 itk1=itype2loc(itype(k+1))
9432 itj=itype2loc(itype(j))
9433 if (l.lt.nres-1) then
9434 itl1=itype2loc(itype(l+1))
9438 C A1 kernel(j+1) A2T
9440 cd write (iout,'(3f10.5,5x,3f10.5)')
9441 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
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.,EUg(1,1,l),EUgder(1,1,l),
9445 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9446 C Following matrices are needed only for 6-th order cumulants
9447 IF (wcorr6.gt.0.0d0) THEN
9448 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9449 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
9450 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(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.,Ug2DtEUg(1,1,l),
9453 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9454 & ADtEAderx(1,1,1,1,1,1))
9456 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9457 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
9458 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9459 & ADtEA1derx(1,1,1,1,1,1))
9461 C End 6-th order cumulants
9464 cd write (2,*) 'In calc_eello6'
9466 cd write (2,*) 'iii=',iii
9468 cd write (2,*) 'kkk=',kkk
9470 cd write (2,'(3(2f10.5),5x)')
9471 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9476 call transpose2(EUgder(1,1,k),auxmat(1,1))
9477 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9478 call transpose2(EUg(1,1,k),auxmat(1,1))
9479 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9480 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9484 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9485 & EAEAderx(1,1,lll,kkk,iii,1))
9489 C A1T kernel(i+1) A2
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.,EUg(1,1,k),EUgder(1,1,k),
9492 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9493 C Following matrices are needed only for 6-th order cumulants
9494 IF (wcorr6.gt.0.0d0) THEN
9495 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9496 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
9497 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9498 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9499 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
9500 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9501 & ADtEAderx(1,1,1,1,1,2))
9502 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9503 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
9504 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9505 & ADtEA1derx(1,1,1,1,1,2))
9507 C End 6-th order cumulants
9508 call transpose2(EUgder(1,1,l),auxmat(1,1))
9509 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
9510 call transpose2(EUg(1,1,l),auxmat(1,1))
9511 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9512 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9516 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9517 & EAEAderx(1,1,lll,kkk,iii,2))
9522 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9523 C They are needed only when the fifth- or the sixth-order cumulants are
9525 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
9526 call transpose2(AEA(1,1,1),auxmat(1,1))
9527 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9528 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9529 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9530 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9531 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9532 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9533 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9534 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9535 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9536 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9537 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9538 call transpose2(AEA(1,1,2),auxmat(1,1))
9539 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
9540 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
9541 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
9542 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9543 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
9544 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
9545 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
9546 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
9547 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
9548 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
9549 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
9550 C Calculate the Cartesian derivatives of the vectors.
9554 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9555 call matvec2(auxmat(1,1),b1(1,i),
9556 & AEAb1derx(1,lll,kkk,iii,1,1))
9557 call matvec2(auxmat(1,1),Ub2(1,i),
9558 & AEAb2derx(1,lll,kkk,iii,1,1))
9559 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9560 & AEAb1derx(1,lll,kkk,iii,2,1))
9561 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9562 & AEAb2derx(1,lll,kkk,iii,2,1))
9563 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9564 call matvec2(auxmat(1,1),b1(1,j),
9565 & AEAb1derx(1,lll,kkk,iii,1,2))
9566 call matvec2(auxmat(1,1),Ub2(1,j),
9567 & AEAb2derx(1,lll,kkk,iii,1,2))
9568 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9569 & AEAb1derx(1,lll,kkk,iii,2,2))
9570 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
9571 & AEAb2derx(1,lll,kkk,iii,2,2))
9578 C Antiparallel orientation of the two CA-CA-CA frames.
9580 iti=itype2loc(itype(i))
9584 itk1=itype2loc(itype(k+1))
9585 itl=itype2loc(itype(l))
9586 itj=itype2loc(itype(j))
9587 if (j.lt.nres-1) then
9588 itj1=itype2loc(itype(j+1))
9592 C A2 kernel(j-1)T A1T
9593 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9594 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
9595 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9596 C Following matrices are needed only for 6-th order cumulants
9597 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9598 & j.eq.i+4 .and. l.eq.i+3)) THEN
9599 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9600 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
9601 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9602 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9603 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
9604 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9605 & ADtEAderx(1,1,1,1,1,1))
9606 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9607 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
9608 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9609 & ADtEA1derx(1,1,1,1,1,1))
9611 C End 6-th order cumulants
9612 call transpose2(EUgder(1,1,k),auxmat(1,1))
9613 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9614 call transpose2(EUg(1,1,k),auxmat(1,1))
9615 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9616 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9620 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9621 & EAEAderx(1,1,lll,kkk,iii,1))
9625 C A2T kernel(i+1)T A1
9626 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9627 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
9628 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9629 C Following matrices are needed only for 6-th order cumulants
9630 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9631 & j.eq.i+4 .and. l.eq.i+3)) THEN
9632 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9633 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
9634 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9635 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9636 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
9637 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9638 & ADtEAderx(1,1,1,1,1,2))
9639 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9640 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
9641 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9642 & ADtEA1derx(1,1,1,1,1,2))
9644 C End 6-th order cumulants
9645 call transpose2(EUgder(1,1,j),auxmat(1,1))
9646 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9647 call transpose2(EUg(1,1,j),auxmat(1,1))
9648 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9649 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9653 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9654 & EAEAderx(1,1,lll,kkk,iii,2))
9659 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9660 C They are needed only when the fifth- or the sixth-order cumulants are
9662 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
9663 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9664 call transpose2(AEA(1,1,1),auxmat(1,1))
9665 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9666 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9667 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9668 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9669 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9670 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9671 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9672 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9673 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9674 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9675 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9676 call transpose2(AEA(1,1,2),auxmat(1,1))
9677 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
9678 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9679 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9680 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9681 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
9682 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9683 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
9684 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
9685 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9686 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9687 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9688 C Calculate the Cartesian derivatives of the vectors.
9692 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9693 call matvec2(auxmat(1,1),b1(1,i),
9694 & AEAb1derx(1,lll,kkk,iii,1,1))
9695 call matvec2(auxmat(1,1),Ub2(1,i),
9696 & AEAb2derx(1,lll,kkk,iii,1,1))
9697 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9698 & AEAb1derx(1,lll,kkk,iii,2,1))
9699 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9700 & AEAb2derx(1,lll,kkk,iii,2,1))
9701 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9702 call matvec2(auxmat(1,1),b1(1,l),
9703 & AEAb1derx(1,lll,kkk,iii,1,2))
9704 call matvec2(auxmat(1,1),Ub2(1,l),
9705 & AEAb2derx(1,lll,kkk,iii,1,2))
9706 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
9707 & AEAb1derx(1,lll,kkk,iii,2,2))
9708 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
9709 & AEAb2derx(1,lll,kkk,iii,2,2))
9718 C---------------------------------------------------------------------------
9719 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
9720 & KK,KKderg,AKA,AKAderg,AKAderx)
9724 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
9725 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
9726 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
9731 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9733 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
9736 cd if (lprn) write (2,*) 'In kernel'
9738 cd if (lprn) write (2,*) 'kkk=',kkk
9740 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
9741 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9743 cd write (2,*) 'lll=',lll
9744 cd write (2,*) 'iii=1'
9746 cd write (2,'(3(2f10.5),5x)')
9747 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9750 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
9751 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9753 cd write (2,*) 'lll=',lll
9754 cd write (2,*) 'iii=2'
9756 cd write (2,'(3(2f10.5),5x)')
9757 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9764 C---------------------------------------------------------------------------
9765 double precision function eello4(i,j,k,l,jj,kk)
9766 implicit real*8 (a-h,o-z)
9767 include 'DIMENSIONS'
9768 include 'COMMON.IOUNITS'
9769 include 'COMMON.CHAIN'
9770 include 'COMMON.DERIV'
9771 include 'COMMON.INTERACT'
9772 include 'COMMON.CONTACTS'
9773 include 'COMMON.TORSION'
9774 include 'COMMON.VAR'
9775 include 'COMMON.GEO'
9776 double precision pizda(2,2),ggg1(3),ggg2(3)
9777 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9781 cd print *,'eello4:',i,j,k,l,jj,kk
9782 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9783 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9784 cold eij=facont_hb(jj,i)
9785 cold ekl=facont_hb(kk,k)
9787 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9788 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9789 gcorr_loc(k-1)=gcorr_loc(k-1)
9790 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9792 gcorr_loc(l-1)=gcorr_loc(l-1)
9793 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9795 gcorr_loc(j-1)=gcorr_loc(j-1)
9796 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9801 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9802 & -EAEAderx(2,2,lll,kkk,iii,1)
9803 cd derx(lll,kkk,iii)=0.0d0
9807 cd gcorr_loc(l-1)=0.0d0
9808 cd gcorr_loc(j-1)=0.0d0
9809 cd gcorr_loc(k-1)=0.0d0
9811 cd write (iout,*)'Contacts have occurred for peptide groups',
9812 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9813 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9814 if (j.lt.nres-1) then
9821 if (l.lt.nres-1) then
9829 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9830 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9831 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9832 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9833 cgrad ghalf=0.5d0*ggg1(ll)
9834 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9835 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9836 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9837 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9838 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9839 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9840 cgrad ghalf=0.5d0*ggg2(ll)
9841 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9842 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9843 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9844 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9845 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9846 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9850 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9855 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9860 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9865 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9869 cd write (2,*) iii,gcorr_loc(iii)
9872 cd write (2,*) 'ekont',ekont
9873 cd write (iout,*) 'eello4',ekont*eel4
9876 C---------------------------------------------------------------------------
9877 double precision function eello5(i,j,k,l,jj,kk)
9878 implicit real*8 (a-h,o-z)
9879 include 'DIMENSIONS'
9880 include 'COMMON.IOUNITS'
9881 include 'COMMON.CHAIN'
9882 include 'COMMON.DERIV'
9883 include 'COMMON.INTERACT'
9884 include 'COMMON.CONTACTS'
9885 include 'COMMON.TORSION'
9886 include 'COMMON.VAR'
9887 include 'COMMON.GEO'
9888 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9889 double precision ggg1(3),ggg2(3)
9890 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9895 C /l\ / \ \ / \ / \ / C
9896 C / \ / \ \ / \ / \ / C
9897 C j| o |l1 | o | o| o | | o |o C
9898 C \ |/k\| |/ \| / |/ \| |/ \| C
9899 C \i/ \ / \ / / \ / \ C
9901 C (I) (II) (III) (IV) C
9903 C eello5_1 eello5_2 eello5_3 eello5_4 C
9905 C Antiparallel chains C
9908 C /j\ / \ \ / \ / \ / C
9909 C / \ / \ \ / \ / \ / C
9910 C j1| o |l | o | o| o | | o |o C
9911 C \ |/k\| |/ \| / |/ \| |/ \| C
9912 C \i/ \ / \ / / \ / \ C
9914 C (I) (II) (III) (IV) C
9916 C eello5_1 eello5_2 eello5_3 eello5_4 C
9918 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9920 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9921 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9926 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9928 itk=itype2loc(itype(k))
9929 itl=itype2loc(itype(l))
9930 itj=itype2loc(itype(j))
9935 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9936 cd & eel5_3_num,eel5_4_num)
9940 derx(lll,kkk,iii)=0.0d0
9944 cd eij=facont_hb(jj,i)
9945 cd ekl=facont_hb(kk,k)
9947 cd write (iout,*)'Contacts have occurred for peptide groups',
9948 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9950 C Contribution from the graph I.
9951 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9952 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9953 call transpose2(EUg(1,1,k),auxmat(1,1))
9954 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9955 vv(1)=pizda(1,1)-pizda(2,2)
9956 vv(2)=pizda(1,2)+pizda(2,1)
9957 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9958 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9959 C Explicit gradient in virtual-dihedral angles.
9960 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9961 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9962 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9963 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9964 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9965 vv(1)=pizda(1,1)-pizda(2,2)
9966 vv(2)=pizda(1,2)+pizda(2,1)
9967 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9968 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9969 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9970 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9971 vv(1)=pizda(1,1)-pizda(2,2)
9972 vv(2)=pizda(1,2)+pizda(2,1)
9974 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9975 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9976 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9978 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9979 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9980 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9982 C Cartesian gradient
9986 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
9988 vv(1)=pizda(1,1)-pizda(2,2)
9989 vv(2)=pizda(1,2)+pizda(2,1)
9990 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9991 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
9992 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9998 C Contribution from graph II
9999 call transpose2(EE(1,1,k),auxmat(1,1))
10000 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
10001 vv(1)=pizda(1,1)+pizda(2,2)
10002 vv(2)=pizda(2,1)-pizda(1,2)
10003 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
10004 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
10005 C Explicit gradient in virtual-dihedral angles.
10006 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10007 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
10008 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
10009 vv(1)=pizda(1,1)+pizda(2,2)
10010 vv(2)=pizda(2,1)-pizda(1,2)
10012 g_corr5_loc(l-1)=g_corr5_loc(l-1)
10013 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
10014 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
10016 g_corr5_loc(j-1)=g_corr5_loc(j-1)
10017 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
10018 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
10020 C Cartesian gradient
10024 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
10026 vv(1)=pizda(1,1)+pizda(2,2)
10027 vv(2)=pizda(2,1)-pizda(1,2)
10028 derx(lll,kkk,iii)=derx(lll,kkk,iii)
10029 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
10030 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
10038 C Parallel orientation
10039 C Contribution from graph III
10040 call transpose2(EUg(1,1,l),auxmat(1,1))
10041 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
10042 vv(1)=pizda(1,1)-pizda(2,2)
10043 vv(2)=pizda(1,2)+pizda(2,1)
10044 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
10045 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
10046 C Explicit gradient in virtual-dihedral angles.
10047 g_corr5_loc(j-1)=g_corr5_loc(j-1)
10048 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
10049 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
10050 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
10051 vv(1)=pizda(1,1)-pizda(2,2)
10052 vv(2)=pizda(1,2)+pizda(2,1)
10053 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10054 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
10055 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
10056 call transpose2(EUgder(1,1,l),auxmat1(1,1))
10057 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
10058 vv(1)=pizda(1,1)-pizda(2,2)
10059 vv(2)=pizda(1,2)+pizda(2,1)
10060 g_corr5_loc(l-1)=g_corr5_loc(l-1)
10061 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
10062 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
10063 C Cartesian gradient
10067 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
10069 vv(1)=pizda(1,1)-pizda(2,2)
10070 vv(2)=pizda(1,2)+pizda(2,1)
10071 derx(lll,kkk,iii)=derx(lll,kkk,iii)
10072 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
10073 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
10078 C Contribution from graph IV
10080 call transpose2(EE(1,1,l),auxmat(1,1))
10081 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
10082 vv(1)=pizda(1,1)+pizda(2,2)
10083 vv(2)=pizda(2,1)-pizda(1,2)
10084 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
10085 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
10086 C Explicit gradient in virtual-dihedral angles.
10087 g_corr5_loc(l-1)=g_corr5_loc(l-1)
10088 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
10089 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
10090 vv(1)=pizda(1,1)+pizda(2,2)
10091 vv(2)=pizda(2,1)-pizda(1,2)
10092 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10093 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
10094 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
10095 C Cartesian gradient
10099 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
10101 vv(1)=pizda(1,1)+pizda(2,2)
10102 vv(2)=pizda(2,1)-pizda(1,2)
10103 derx(lll,kkk,iii)=derx(lll,kkk,iii)
10104 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
10105 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
10110 C Antiparallel orientation
10111 C Contribution from graph III
10113 call transpose2(EUg(1,1,j),auxmat(1,1))
10114 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
10115 vv(1)=pizda(1,1)-pizda(2,2)
10116 vv(2)=pizda(1,2)+pizda(2,1)
10117 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
10118 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
10119 C Explicit gradient in virtual-dihedral angles.
10120 g_corr5_loc(l-1)=g_corr5_loc(l-1)
10121 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
10122 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
10123 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
10124 vv(1)=pizda(1,1)-pizda(2,2)
10125 vv(2)=pizda(1,2)+pizda(2,1)
10126 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10127 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
10128 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
10129 call transpose2(EUgder(1,1,j),auxmat1(1,1))
10130 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
10131 vv(1)=pizda(1,1)-pizda(2,2)
10132 vv(2)=pizda(1,2)+pizda(2,1)
10133 g_corr5_loc(j-1)=g_corr5_loc(j-1)
10134 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
10135 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
10136 C Cartesian gradient
10140 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
10142 vv(1)=pizda(1,1)-pizda(2,2)
10143 vv(2)=pizda(1,2)+pizda(2,1)
10144 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
10145 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
10146 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
10151 C Contribution from graph IV
10153 call transpose2(EE(1,1,j),auxmat(1,1))
10154 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
10155 vv(1)=pizda(1,1)+pizda(2,2)
10156 vv(2)=pizda(2,1)-pizda(1,2)
10157 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
10158 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
10159 C Explicit gradient in virtual-dihedral angles.
10160 g_corr5_loc(j-1)=g_corr5_loc(j-1)
10161 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
10162 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
10163 vv(1)=pizda(1,1)+pizda(2,2)
10164 vv(2)=pizda(2,1)-pizda(1,2)
10165 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10166 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
10167 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
10168 C Cartesian gradient
10172 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
10174 vv(1)=pizda(1,1)+pizda(2,2)
10175 vv(2)=pizda(2,1)-pizda(1,2)
10176 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
10177 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
10178 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
10184 eel5=eello5_1+eello5_2+eello5_3+eello5_4
10185 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
10186 cd write (2,*) 'ijkl',i,j,k,l
10187 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
10188 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
10190 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
10191 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
10192 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
10193 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
10194 if (j.lt.nres-1) then
10201 if (l.lt.nres-1) then
10211 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
10212 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
10213 C summed up outside the subrouine as for the other subroutines
10214 C handling long-range interactions. The old code is commented out
10215 C with "cgrad" to keep track of changes.
10217 cgrad ggg1(ll)=eel5*g_contij(ll,1)
10218 cgrad ggg2(ll)=eel5*g_contij(ll,2)
10219 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
10220 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
10221 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
10222 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
10223 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
10224 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
10225 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
10226 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
10228 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
10229 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
10230 cgrad ghalf=0.5d0*ggg1(ll)
10232 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
10233 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
10234 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
10235 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
10236 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
10237 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
10238 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
10239 cgrad ghalf=0.5d0*ggg2(ll)
10241 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
10242 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
10243 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
10244 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
10245 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
10246 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
10251 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
10252 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
10257 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
10258 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
10264 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
10269 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
10273 cd write (2,*) iii,g_corr5_loc(iii)
10276 cd write (2,*) 'ekont',ekont
10277 cd write (iout,*) 'eello5',ekont*eel5
10280 c--------------------------------------------------------------------------
10281 double precision function eello6(i,j,k,l,jj,kk)
10282 implicit real*8 (a-h,o-z)
10283 include 'DIMENSIONS'
10284 include 'COMMON.IOUNITS'
10285 include 'COMMON.CHAIN'
10286 include 'COMMON.DERIV'
10287 include 'COMMON.INTERACT'
10288 include 'COMMON.CONTACTS'
10289 include 'COMMON.TORSION'
10290 include 'COMMON.VAR'
10291 include 'COMMON.GEO'
10292 include 'COMMON.FFIELD'
10293 double precision ggg1(3),ggg2(3)
10294 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10299 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10307 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
10308 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
10312 derx(lll,kkk,iii)=0.0d0
10316 cd eij=facont_hb(jj,i)
10317 cd ekl=facont_hb(kk,k)
10323 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
10324 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
10325 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
10326 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
10327 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
10328 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
10330 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
10331 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
10332 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
10333 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
10334 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
10335 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10339 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
10341 C If turn contributions are considered, they will be handled separately.
10342 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
10343 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
10344 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
10345 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
10346 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
10347 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
10348 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
10350 if (j.lt.nres-1) then
10357 if (l.lt.nres-1) then
10365 cgrad ggg1(ll)=eel6*g_contij(ll,1)
10366 cgrad ggg2(ll)=eel6*g_contij(ll,2)
10367 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
10368 cgrad ghalf=0.5d0*ggg1(ll)
10370 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
10371 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
10372 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
10373 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
10374 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
10375 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
10376 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
10377 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
10378 cgrad ghalf=0.5d0*ggg2(ll)
10379 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
10381 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
10382 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
10383 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
10384 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
10385 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
10386 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
10391 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
10392 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
10397 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
10398 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
10404 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
10409 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
10413 cd write (2,*) iii,g_corr6_loc(iii)
10416 cd write (2,*) 'ekont',ekont
10417 cd write (iout,*) 'eello6',ekont*eel6
10420 c--------------------------------------------------------------------------
10421 double precision function eello6_graph1(i,j,k,l,imat,swap)
10422 implicit real*8 (a-h,o-z)
10423 include 'DIMENSIONS'
10424 include 'COMMON.IOUNITS'
10425 include 'COMMON.CHAIN'
10426 include 'COMMON.DERIV'
10427 include 'COMMON.INTERACT'
10428 include 'COMMON.CONTACTS'
10429 include 'COMMON.TORSION'
10430 include 'COMMON.VAR'
10431 include 'COMMON.GEO'
10432 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
10435 common /kutas/ lprn
10436 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10438 C Parallel Antiparallel C
10444 C \ j|/k\| / \ |/k\|l / C
10445 C \ / \ / \ / \ / C
10449 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10450 itk=itype2loc(itype(k))
10451 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
10452 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
10453 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
10454 call transpose2(EUgC(1,1,k),auxmat(1,1))
10455 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10456 vv1(1)=pizda1(1,1)-pizda1(2,2)
10457 vv1(2)=pizda1(1,2)+pizda1(2,1)
10458 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10459 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
10460 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
10461 s5=scalar2(vv(1),Dtobr2(1,i))
10462 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
10463 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
10464 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
10465 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
10466 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
10467 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
10468 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
10469 & +scalar2(vv(1),Dtobr2der(1,i)))
10470 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
10471 vv1(1)=pizda1(1,1)-pizda1(2,2)
10472 vv1(2)=pizda1(1,2)+pizda1(2,1)
10473 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
10474 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
10476 g_corr6_loc(l-1)=g_corr6_loc(l-1)
10477 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
10478 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
10479 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
10480 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10482 g_corr6_loc(j-1)=g_corr6_loc(j-1)
10483 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
10484 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
10485 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
10486 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10488 call transpose2(EUgCder(1,1,k),auxmat(1,1))
10489 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10490 vv1(1)=pizda1(1,1)-pizda1(2,2)
10491 vv1(2)=pizda1(1,2)+pizda1(2,1)
10492 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
10493 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
10494 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
10495 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
10504 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
10505 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
10506 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
10507 call transpose2(EUgC(1,1,k),auxmat(1,1))
10508 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10510 vv1(1)=pizda1(1,1)-pizda1(2,2)
10511 vv1(2)=pizda1(1,2)+pizda1(2,1)
10512 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10513 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
10514 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
10515 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
10516 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
10517 s5=scalar2(vv(1),Dtobr2(1,i))
10518 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
10524 c----------------------------------------------------------------------------
10525 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
10526 implicit real*8 (a-h,o-z)
10527 include 'DIMENSIONS'
10528 include 'COMMON.IOUNITS'
10529 include 'COMMON.CHAIN'
10530 include 'COMMON.DERIV'
10531 include 'COMMON.INTERACT'
10532 include 'COMMON.CONTACTS'
10533 include 'COMMON.TORSION'
10534 include 'COMMON.VAR'
10535 include 'COMMON.GEO'
10537 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10538 & auxvec1(2),auxvec2(2),auxmat1(2,2)
10540 common /kutas/ lprn
10541 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10543 C Parallel Antiparallel C
10549 C \ j|/k\| \ |/k\|l C
10554 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10555 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
10556 C AL 7/4/01 s1 would occur in the sixth-order moment,
10557 C but not in a cluster cumulant
10559 s1=dip(1,jj,i)*dip(1,kk,k)
10561 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
10562 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10563 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
10564 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
10565 call transpose2(EUg(1,1,k),auxmat(1,1))
10566 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
10567 vv(1)=pizda(1,1)-pizda(2,2)
10568 vv(2)=pizda(1,2)+pizda(2,1)
10569 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10570 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10572 eello6_graph2=-(s1+s2+s3+s4)
10574 eello6_graph2=-(s2+s3+s4)
10576 c eello6_graph2=-s3
10577 C Derivatives in gamma(i-1)
10580 s1=dipderg(1,jj,i)*dip(1,kk,k)
10582 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10583 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
10584 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10585 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10587 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10589 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10591 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
10593 C Derivatives in gamma(k-1)
10595 s1=dip(1,jj,i)*dipderg(1,kk,k)
10597 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
10598 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10599 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
10600 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10601 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10602 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
10603 vv(1)=pizda(1,1)-pizda(2,2)
10604 vv(2)=pizda(1,2)+pizda(2,1)
10605 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10607 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10609 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10611 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
10612 C Derivatives in gamma(j-1) or gamma(l-1)
10615 s1=dipderg(3,jj,i)*dip(1,kk,k)
10617 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
10618 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10619 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
10620 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
10621 vv(1)=pizda(1,1)-pizda(2,2)
10622 vv(2)=pizda(1,2)+pizda(2,1)
10623 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10626 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10628 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10631 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10632 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10634 C Derivatives in gamma(l-1) or gamma(j-1)
10637 s1=dip(1,jj,i)*dipderg(3,kk,k)
10639 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10640 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10641 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10642 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10643 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10644 vv(1)=pizda(1,1)-pizda(2,2)
10645 vv(2)=pizda(1,2)+pizda(2,1)
10646 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10649 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10651 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10654 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10655 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10657 C Cartesian derivatives.
10659 write (2,*) 'In eello6_graph2'
10661 write (2,*) 'iii=',iii
10663 write (2,*) 'kkk=',kkk
10665 write (2,'(3(2f10.5),5x)')
10666 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10676 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10678 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10681 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
10683 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10684 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
10686 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10687 call transpose2(EUg(1,1,k),auxmat(1,1))
10688 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
10690 vv(1)=pizda(1,1)-pizda(2,2)
10691 vv(2)=pizda(1,2)+pizda(2,1)
10692 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10693 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10695 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10697 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10700 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10702 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10709 c----------------------------------------------------------------------------
10710 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
10711 implicit real*8 (a-h,o-z)
10712 include 'DIMENSIONS'
10713 include 'COMMON.IOUNITS'
10714 include 'COMMON.CHAIN'
10715 include 'COMMON.DERIV'
10716 include 'COMMON.INTERACT'
10717 include 'COMMON.CONTACTS'
10718 include 'COMMON.TORSION'
10719 include 'COMMON.VAR'
10720 include 'COMMON.GEO'
10721 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
10723 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10725 C Parallel Antiparallel C
10730 C /| o |o o| o |\ C
10731 C j|/k\| / |/k\|l / C
10736 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10738 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10739 C energy moment and not to the cluster cumulant.
10740 iti=itortyp(itype(i))
10741 if (j.lt.nres-1) then
10742 itj1=itype2loc(itype(j+1))
10746 itk=itype2loc(itype(k))
10747 itk1=itype2loc(itype(k+1))
10748 if (l.lt.nres-1) then
10749 itl1=itype2loc(itype(l+1))
10754 s1=dip(4,jj,i)*dip(4,kk,k)
10756 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
10757 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10758 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
10759 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10760 call transpose2(EE(1,1,k),auxmat(1,1))
10761 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10762 vv(1)=pizda(1,1)+pizda(2,2)
10763 vv(2)=pizda(2,1)-pizda(1,2)
10764 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10765 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10766 cd & "sum",-(s2+s3+s4)
10768 eello6_graph3=-(s1+s2+s3+s4)
10770 eello6_graph3=-(s2+s3+s4)
10772 c eello6_graph3=-s4
10773 C Derivatives in gamma(k-1)
10774 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
10775 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10776 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10777 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10778 C Derivatives in gamma(l-1)
10779 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
10780 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10781 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10782 vv(1)=pizda(1,1)+pizda(2,2)
10783 vv(2)=pizda(2,1)-pizda(1,2)
10784 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10785 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10786 C Cartesian derivatives.
10792 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10794 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10797 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
10799 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10800 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
10802 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10803 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
10805 vv(1)=pizda(1,1)+pizda(2,2)
10806 vv(2)=pizda(2,1)-pizda(1,2)
10807 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10809 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10811 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10814 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10816 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10818 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10824 c----------------------------------------------------------------------------
10825 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10826 implicit real*8 (a-h,o-z)
10827 include 'DIMENSIONS'
10828 include 'COMMON.IOUNITS'
10829 include 'COMMON.CHAIN'
10830 include 'COMMON.DERIV'
10831 include 'COMMON.INTERACT'
10832 include 'COMMON.CONTACTS'
10833 include 'COMMON.TORSION'
10834 include 'COMMON.VAR'
10835 include 'COMMON.GEO'
10836 include 'COMMON.FFIELD'
10837 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10838 & auxvec1(2),auxmat1(2,2)
10840 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10842 C Parallel Antiparallel C
10847 C /| o |o o| o |\ C
10848 C \ j|/k\| \ |/k\|l C
10853 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10855 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10856 C energy moment and not to the cluster cumulant.
10857 cd write (2,*) 'eello_graph4: wturn6',wturn6
10858 iti=itype2loc(itype(i))
10859 itj=itype2loc(itype(j))
10860 if (j.lt.nres-1) then
10861 itj1=itype2loc(itype(j+1))
10865 itk=itype2loc(itype(k))
10866 if (k.lt.nres-1) then
10867 itk1=itype2loc(itype(k+1))
10871 itl=itype2loc(itype(l))
10872 if (l.lt.nres-1) then
10873 itl1=itype2loc(itype(l+1))
10877 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10878 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10879 cd & ' itl',itl,' itl1',itl1
10881 if (imat.eq.1) then
10882 s1=dip(3,jj,i)*dip(3,kk,k)
10884 s1=dip(2,jj,j)*dip(2,kk,l)
10887 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10888 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10890 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
10891 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10893 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
10894 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10896 call transpose2(EUg(1,1,k),auxmat(1,1))
10897 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10898 vv(1)=pizda(1,1)-pizda(2,2)
10899 vv(2)=pizda(2,1)+pizda(1,2)
10900 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10901 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10903 eello6_graph4=-(s1+s2+s3+s4)
10905 eello6_graph4=-(s2+s3+s4)
10907 C Derivatives in gamma(i-1)
10910 if (imat.eq.1) then
10911 s1=dipderg(2,jj,i)*dip(3,kk,k)
10913 s1=dipderg(4,jj,j)*dip(2,kk,l)
10916 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10918 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
10919 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10921 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
10922 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10924 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10925 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10926 cd write (2,*) 'turn6 derivatives'
10928 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10930 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10934 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10936 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10940 C Derivatives in gamma(k-1)
10942 if (imat.eq.1) then
10943 s1=dip(3,jj,i)*dipderg(2,kk,k)
10945 s1=dip(2,jj,j)*dipderg(4,kk,l)
10948 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10949 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10951 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
10952 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10954 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
10955 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10957 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10958 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10959 vv(1)=pizda(1,1)-pizda(2,2)
10960 vv(2)=pizda(2,1)+pizda(1,2)
10961 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10962 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10964 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10966 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10970 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10972 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10975 C Derivatives in gamma(j-1) or gamma(l-1)
10976 if (l.eq.j+1 .and. l.gt.1) then
10977 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10978 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10979 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10980 vv(1)=pizda(1,1)-pizda(2,2)
10981 vv(2)=pizda(2,1)+pizda(1,2)
10982 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10983 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10984 else if (j.gt.1) then
10985 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10986 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10987 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10988 vv(1)=pizda(1,1)-pizda(2,2)
10989 vv(2)=pizda(2,1)+pizda(1,2)
10990 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10991 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10992 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10994 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10997 C Cartesian derivatives.
11003 if (imat.eq.1) then
11004 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
11006 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
11009 if (imat.eq.1) then
11010 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
11012 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
11016 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
11018 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
11020 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
11021 & b1(1,j+1),auxvec(1))
11022 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
11024 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
11025 & b1(1,l+1),auxvec(1))
11026 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
11028 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
11030 vv(1)=pizda(1,1)-pizda(2,2)
11031 vv(2)=pizda(2,1)+pizda(1,2)
11032 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
11034 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
11036 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
11039 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
11042 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
11045 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
11047 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
11049 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
11053 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
11055 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
11058 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
11060 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
11068 c----------------------------------------------------------------------------
11069 double precision function eello_turn6(i,jj,kk)
11070 implicit real*8 (a-h,o-z)
11071 include 'DIMENSIONS'
11072 include 'COMMON.IOUNITS'
11073 include 'COMMON.CHAIN'
11074 include 'COMMON.DERIV'
11075 include 'COMMON.INTERACT'
11076 include 'COMMON.CONTACTS'
11077 include 'COMMON.TORSION'
11078 include 'COMMON.VAR'
11079 include 'COMMON.GEO'
11080 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
11081 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
11083 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
11084 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
11085 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
11086 C the respective energy moment and not to the cluster cumulant.
11095 iti=itype2loc(itype(i))
11096 itk=itype2loc(itype(k))
11097 itk1=itype2loc(itype(k+1))
11098 itl=itype2loc(itype(l))
11099 itj=itype2loc(itype(j))
11100 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
11101 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
11102 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
11107 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
11109 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
11113 derx_turn(lll,kkk,iii)=0.0d0
11120 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
11122 cd write (2,*) 'eello6_5',eello6_5
11124 call transpose2(AEA(1,1,1),auxmat(1,1))
11125 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
11126 ss1=scalar2(Ub2(1,i+2),b1(1,l))
11127 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
11129 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
11130 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
11131 s2 = scalar2(b1(1,k),vtemp1(1))
11133 call transpose2(AEA(1,1,2),atemp(1,1))
11134 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
11135 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
11136 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
11138 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
11139 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
11140 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
11142 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
11143 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
11144 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
11145 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
11146 ss13 = scalar2(b1(1,k),vtemp4(1))
11147 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
11149 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
11155 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
11156 C Derivatives in gamma(i+2)
11160 call transpose2(AEA(1,1,1),auxmatd(1,1))
11161 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
11162 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
11163 call transpose2(AEAderg(1,1,2),atempd(1,1))
11164 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
11165 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
11167 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
11168 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
11169 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
11175 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
11176 C Derivatives in gamma(i+3)
11178 call transpose2(AEA(1,1,1),auxmatd(1,1))
11179 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
11180 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
11181 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
11183 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
11184 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
11185 s2d = scalar2(b1(1,k),vtemp1d(1))
11187 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
11188 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
11190 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
11192 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
11193 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
11194 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
11202 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
11203 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
11205 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
11206 & -0.5d0*ekont*(s2d+s12d)
11208 C Derivatives in gamma(i+4)
11209 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
11210 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
11211 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
11213 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
11214 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
11215 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
11223 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
11225 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
11227 C Derivatives in gamma(i+5)
11229 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
11230 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
11231 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
11233 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
11234 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
11235 s2d = scalar2(b1(1,k),vtemp1d(1))
11237 call transpose2(AEA(1,1,2),atempd(1,1))
11238 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
11239 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
11241 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
11242 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
11244 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
11245 ss13d = scalar2(b1(1,k),vtemp4d(1))
11246 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
11254 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
11255 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
11257 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
11258 & -0.5d0*ekont*(s2d+s12d)
11260 C Cartesian derivatives
11265 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
11266 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
11267 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
11269 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
11270 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
11272 s2d = scalar2(b1(1,k),vtemp1d(1))
11274 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
11275 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
11276 s8d = -(atempd(1,1)+atempd(2,2))*
11277 & scalar2(cc(1,1,itl),vtemp2(1))
11279 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
11281 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
11282 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
11289 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
11290 & - 0.5d0*(s1d+s2d)
11292 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
11296 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
11297 & - 0.5d0*(s8d+s12d)
11299 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
11308 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
11309 & achuj_tempd(1,1))
11310 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
11311 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
11312 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
11313 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
11314 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
11316 ss13d = scalar2(b1(1,k),vtemp4d(1))
11317 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
11318 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
11322 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
11323 cd & 16*eel_turn6_num
11325 if (j.lt.nres-1) then
11332 if (l.lt.nres-1) then
11340 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
11341 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
11342 cgrad ghalf=0.5d0*ggg1(ll)
11344 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
11345 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
11346 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
11347 & +ekont*derx_turn(ll,2,1)
11348 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
11349 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
11350 & +ekont*derx_turn(ll,4,1)
11351 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
11352 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
11353 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
11354 cgrad ghalf=0.5d0*ggg2(ll)
11356 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
11357 & +ekont*derx_turn(ll,2,2)
11358 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
11359 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
11360 & +ekont*derx_turn(ll,4,2)
11361 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
11362 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
11363 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
11368 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
11373 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
11379 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
11384 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
11388 cd write (2,*) iii,g_corr6_loc(iii)
11390 eello_turn6=ekont*eel_turn6
11391 cd write (2,*) 'ekont',ekont
11392 cd write (2,*) 'eel_turn6',ekont*eel_turn6
11396 C-----------------------------------------------------------------------------
11397 double precision function scalar(u,v)
11398 !DIR$ INLINEALWAYS scalar
11400 cDEC$ ATTRIBUTES FORCEINLINE::scalar
11403 double precision u(3),v(3)
11404 cd double precision sc
11412 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
11415 crc-------------------------------------------------
11416 SUBROUTINE MATVEC2(A1,V1,V2)
11417 !DIR$ INLINEALWAYS MATVEC2
11419 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
11421 implicit real*8 (a-h,o-z)
11422 include 'DIMENSIONS'
11423 DIMENSION A1(2,2),V1(2),V2(2)
11427 c 3 VI=VI+A1(I,K)*V1(K)
11431 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
11432 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
11437 C---------------------------------------
11438 SUBROUTINE MATMAT2(A1,A2,A3)
11440 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
11442 implicit real*8 (a-h,o-z)
11443 include 'DIMENSIONS'
11444 DIMENSION A1(2,2),A2(2,2),A3(2,2)
11445 c DIMENSION AI3(2,2)
11449 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
11455 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
11456 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
11457 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
11458 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
11466 c-------------------------------------------------------------------------
11467 double precision function scalar2(u,v)
11468 !DIR$ INLINEALWAYS scalar2
11470 double precision u(2),v(2)
11471 double precision sc
11473 scalar2=u(1)*v(1)+u(2)*v(2)
11477 C-----------------------------------------------------------------------------
11479 subroutine transpose2(a,at)
11480 !DIR$ INLINEALWAYS transpose2
11482 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
11485 double precision a(2,2),at(2,2)
11492 c--------------------------------------------------------------------------
11493 subroutine transpose(n,a,at)
11496 double precision a(n,n),at(n,n)
11504 C---------------------------------------------------------------------------
11505 subroutine prodmat3(a1,a2,kk,transp,prod)
11506 !DIR$ INLINEALWAYS prodmat3
11508 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
11512 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
11514 crc double precision auxmat(2,2),prod_(2,2)
11517 crc call transpose2(kk(1,1),auxmat(1,1))
11518 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
11519 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11521 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
11522 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
11523 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
11524 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
11525 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
11526 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
11527 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
11528 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
11531 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
11532 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11534 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
11535 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
11536 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
11537 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
11538 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
11539 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
11540 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
11541 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
11544 c call transpose2(a2(1,1),a2t(1,1))
11547 crc print *,((prod_(i,j),i=1,2),j=1,2)
11548 crc print *,((prod(i,j),i=1,2),j=1,2)
11552 CCC----------------------------------------------
11553 subroutine Eliptransfer(eliptran)
11554 implicit real*8 (a-h,o-z)
11555 include 'DIMENSIONS'
11556 include 'COMMON.GEO'
11557 include 'COMMON.VAR'
11558 include 'COMMON.LOCAL'
11559 include 'COMMON.CHAIN'
11560 include 'COMMON.DERIV'
11561 include 'COMMON.NAMES'
11562 include 'COMMON.INTERACT'
11563 include 'COMMON.IOUNITS'
11564 include 'COMMON.CALC'
11565 include 'COMMON.CONTROL'
11566 include 'COMMON.SPLITELE'
11567 include 'COMMON.SBRIDGE'
11568 C this is done by Adasko
11569 C print *,"wchodze"
11570 C structure of box:
11572 C--bordliptop-- buffore starts
11573 C--bufliptop--- here true lipid starts
11575 C--buflipbot--- lipid ends buffore starts
11576 C--bordlipbot--buffore ends
11578 do i=ilip_start,ilip_end
11580 if (itype(i).eq.ntyp1) cycle
11582 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
11583 if (positi.le.0.0) positi=positi+boxzsize
11585 C first for peptide groups
11586 c for each residue check if it is in lipid or lipid water border area
11587 if ((positi.gt.bordlipbot)
11588 &.and.(positi.lt.bordliptop)) then
11589 C the energy transfer exist
11590 if (positi.lt.buflipbot) then
11591 C what fraction I am in
11593 & ((positi-bordlipbot)/lipbufthick)
11594 C lipbufthick is thickenes of lipid buffore
11595 sslip=sscalelip(fracinbuf)
11596 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11597 eliptran=eliptran+sslip*pepliptran
11598 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11599 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11600 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11602 C print *,"doing sccale for lower part"
11603 C print *,i,sslip,fracinbuf,ssgradlip
11604 elseif (positi.gt.bufliptop) then
11605 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
11606 sslip=sscalelip(fracinbuf)
11607 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11608 eliptran=eliptran+sslip*pepliptran
11609 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11610 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11611 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11612 C print *, "doing sscalefor top part"
11613 C print *,i,sslip,fracinbuf,ssgradlip
11615 eliptran=eliptran+pepliptran
11616 C print *,"I am in true lipid"
11619 C eliptran=elpitran+0.0 ! I am in water
11622 C print *, "nic nie bylo w lipidzie?"
11623 C now multiply all by the peptide group transfer factor
11624 C eliptran=eliptran*pepliptran
11625 C now the same for side chains
11627 do i=ilip_start,ilip_end
11628 if (itype(i).eq.ntyp1) cycle
11629 positi=(mod(c(3,i+nres),boxzsize))
11630 if (positi.le.0) positi=positi+boxzsize
11631 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
11632 c for each residue check if it is in lipid or lipid water border area
11633 C respos=mod(c(3,i+nres),boxzsize)
11634 C print *,positi,bordlipbot,buflipbot
11635 if ((positi.gt.bordlipbot)
11636 & .and.(positi.lt.bordliptop)) then
11637 C the energy transfer exist
11638 if (positi.lt.buflipbot) then
11640 & ((positi-bordlipbot)/lipbufthick)
11641 C lipbufthick is thickenes of lipid buffore
11642 sslip=sscalelip(fracinbuf)
11643 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11644 eliptran=eliptran+sslip*liptranene(itype(i))
11645 gliptranx(3,i)=gliptranx(3,i)
11646 &+ssgradlip*liptranene(itype(i))
11647 gliptranc(3,i-1)= gliptranc(3,i-1)
11648 &+ssgradlip*liptranene(itype(i))
11649 C print *,"doing sccale for lower part"
11650 elseif (positi.gt.bufliptop) then
11652 &((bordliptop-positi)/lipbufthick)
11653 sslip=sscalelip(fracinbuf)
11654 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11655 eliptran=eliptran+sslip*liptranene(itype(i))
11656 gliptranx(3,i)=gliptranx(3,i)
11657 &+ssgradlip*liptranene(itype(i))
11658 gliptranc(3,i-1)= gliptranc(3,i-1)
11659 &+ssgradlip*liptranene(itype(i))
11660 C print *, "doing sscalefor top part",sslip,fracinbuf
11662 eliptran=eliptran+liptranene(itype(i))
11663 C print *,"I am in true lipid"
11665 endif ! if in lipid or buffor
11667 C eliptran=elpitran+0.0 ! I am in water
11671 C---------------------------------------------------------
11672 C AFM soubroutine for constant force
11673 subroutine AFMforce(Eafmforce)
11674 implicit real*8 (a-h,o-z)
11675 include 'DIMENSIONS'
11676 include 'COMMON.GEO'
11677 include 'COMMON.VAR'
11678 include 'COMMON.LOCAL'
11679 include 'COMMON.CHAIN'
11680 include 'COMMON.DERIV'
11681 include 'COMMON.NAMES'
11682 include 'COMMON.INTERACT'
11683 include 'COMMON.IOUNITS'
11684 include 'COMMON.CALC'
11685 include 'COMMON.CONTROL'
11686 include 'COMMON.SPLITELE'
11687 include 'COMMON.SBRIDGE'
11692 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11693 dist=dist+diffafm(i)**2
11696 Eafmforce=-forceAFMconst*(dist-distafminit)
11698 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
11699 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
11701 C print *,'AFM',Eafmforce
11704 C---------------------------------------------------------
11705 C AFM subroutine with pseudoconstant velocity
11706 subroutine AFMvel(Eafmforce)
11707 implicit real*8 (a-h,o-z)
11708 include 'DIMENSIONS'
11709 include 'COMMON.GEO'
11710 include 'COMMON.VAR'
11711 include 'COMMON.LOCAL'
11712 include 'COMMON.CHAIN'
11713 include 'COMMON.DERIV'
11714 include 'COMMON.NAMES'
11715 include 'COMMON.INTERACT'
11716 include 'COMMON.IOUNITS'
11717 include 'COMMON.CALC'
11718 include 'COMMON.CONTROL'
11719 include 'COMMON.SPLITELE'
11720 include 'COMMON.SBRIDGE'
11722 C Only for check grad COMMENT if not used for checkgrad
11724 C--------------------------------------------------------
11725 C print *,"wchodze"
11729 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11730 dist=dist+diffafm(i)**2
11733 Eafmforce=0.5d0*forceAFMconst
11734 & *(distafminit+totTafm*velAFMconst-dist)**2
11735 C Eafmforce=-forceAFMconst*(dist-distafminit)
11737 gradafm(i,afmend-1)=-forceAFMconst*
11738 &(distafminit+totTafm*velAFMconst-dist)
11740 gradafm(i,afmbeg-1)=forceAFMconst*
11741 &(distafminit+totTafm*velAFMconst-dist)
11744 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
11747 C-----------------------------------------------------------
11748 C first for shielding is setting of function of side-chains
11749 subroutine set_shield_fac
11750 implicit real*8 (a-h,o-z)
11751 include 'DIMENSIONS'
11752 include 'COMMON.CHAIN'
11753 include 'COMMON.DERIV'
11754 include 'COMMON.IOUNITS'
11755 include 'COMMON.SHIELD'
11756 include 'COMMON.INTERACT'
11757 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11758 double precision div77_81/0.974996043d0/,
11759 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11761 C the vector between center of side_chain and peptide group
11762 double precision pep_side(3),long,side_calf(3),
11763 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11764 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11765 C the line belowe needs to be changed for FGPROC>1
11767 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11769 Cif there two consequtive dummy atoms there is no peptide group between them
11770 C the line below has to be changed for FGPROC>1
11773 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11777 C first lets set vector conecting the ithe side-chain with kth side-chain
11778 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11779 C pep_side(j)=2.0d0
11780 C and vector conecting the side-chain with its proper calfa
11781 side_calf(j)=c(j,k+nres)-c(j,k)
11782 C side_calf(j)=2.0d0
11783 pept_group(j)=c(j,i)-c(j,i+1)
11784 C lets have their lenght
11785 dist_pep_side=pep_side(j)**2+dist_pep_side
11786 dist_side_calf=dist_side_calf+side_calf(j)**2
11787 dist_pept_group=dist_pept_group+pept_group(j)**2
11789 dist_pep_side=dsqrt(dist_pep_side)
11790 dist_pept_group=dsqrt(dist_pept_group)
11791 dist_side_calf=dsqrt(dist_side_calf)
11793 pep_side_norm(j)=pep_side(j)/dist_pep_side
11794 side_calf_norm(j)=dist_side_calf
11796 C now sscale fraction
11797 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
11798 C print *,buff_shield,"buff"
11800 if (sh_frac_dist.le.0.0) cycle
11801 C If we reach here it means that this side chain reaches the shielding sphere
11802 C Lets add him to the list for gradient
11803 ishield_list(i)=ishield_list(i)+1
11804 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
11805 C this list is essential otherwise problem would be O3
11806 shield_list(ishield_list(i),i)=k
11807 C Lets have the sscale value
11808 if (sh_frac_dist.gt.1.0) then
11809 scale_fac_dist=1.0d0
11811 sh_frac_dist_grad(j)=0.0d0
11814 scale_fac_dist=-sh_frac_dist*sh_frac_dist
11815 & *(2.0*sh_frac_dist-3.0d0)
11816 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
11817 & /dist_pep_side/buff_shield*0.5
11818 C remember for the final gradient multiply sh_frac_dist_grad(j)
11819 C for side_chain by factor -2 !
11821 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
11822 C print *,"jestem",scale_fac_dist,fac_help_scale,
11823 C & sh_frac_dist_grad(j)
11826 C if ((i.eq.3).and.(k.eq.2)) then
11827 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
11831 C this is what is now we have the distance scaling now volume...
11832 short=short_r_sidechain(itype(k))
11833 long=long_r_sidechain(itype(k))
11834 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
11837 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
11838 C costhet_fac=0.0d0
11840 costhet_grad(j)=costhet_fac*pep_side(j)
11842 C remember for the final gradient multiply costhet_grad(j)
11843 C for side_chain by factor -2 !
11844 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
11845 C pep_side0pept_group is vector multiplication
11846 pep_side0pept_group=0.0
11848 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
11850 cosalfa=(pep_side0pept_group/
11851 & (dist_pep_side*dist_side_calf))
11852 fac_alfa_sin=1.0-cosalfa**2
11853 fac_alfa_sin=dsqrt(fac_alfa_sin)
11854 rkprim=fac_alfa_sin*(long-short)+short
11856 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
11857 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
11860 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
11861 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11862 &*(long-short)/fac_alfa_sin*cosalfa/
11863 &((dist_pep_side*dist_side_calf))*
11864 &((side_calf(j))-cosalfa*
11865 &((pep_side(j)/dist_pep_side)*dist_side_calf))
11867 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11868 &*(long-short)/fac_alfa_sin*cosalfa
11869 &/((dist_pep_side*dist_side_calf))*
11871 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
11874 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
11877 C now the gradient...
11878 C grad_shield is gradient of Calfa for peptide groups
11879 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
11881 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
11882 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
11884 grad_shield(j,i)=grad_shield(j,i)
11885 C gradient po skalowaniu
11886 & +(sh_frac_dist_grad(j)
11887 C gradient po costhet
11888 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
11889 &-scale_fac_dist*(cosphi_grad_long(j))
11890 &/(1.0-cosphi) )*div77_81
11892 C grad_shield_side is Cbeta sidechain gradient
11893 grad_shield_side(j,ishield_list(i),i)=
11894 & (sh_frac_dist_grad(j)*-2.0d0
11895 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
11896 & +scale_fac_dist*(cosphi_grad_long(j))
11897 & *2.0d0/(1.0-cosphi))
11898 & *div77_81*VofOverlap
11900 grad_shield_loc(j,ishield_list(i),i)=
11901 & scale_fac_dist*cosphi_grad_loc(j)
11902 & *2.0d0/(1.0-cosphi)
11903 & *div77_81*VofOverlap
11905 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
11907 fac_shield(i)=VolumeTotal*div77_81+div4_81
11908 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
11912 C--------------------------------------------------------------------------
11913 double precision function tschebyshev(m,n,x,y)
11915 include "DIMENSIONS"
11917 double precision x(n),y,yy(0:maxvar),aux
11918 c Tschebyshev polynomial. Note that the first term is omitted
11919 c m=0: the constant term is included
11920 c m=1: the constant term is not included
11924 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
11933 C--------------------------------------------------------------------------
11934 double precision function gradtschebyshev(m,n,x,y)
11936 include "DIMENSIONS"
11938 double precision x(n+1),y,yy(0:maxvar),aux
11939 c Tschebyshev polynomial. Note that the first term is omitted
11940 c m=0: the constant term is included
11941 c m=1: the constant term is not included
11945 yy(i)=2*y*yy(i-1)-yy(i-2)
11949 aux=aux+x(i+1)*yy(i)*(i+1)
11950 C print *, x(i+1),yy(i),i
11952 gradtschebyshev=aux
11955 C------------------------------------------------------------------------
11956 C first for shielding is setting of function of side-chains
11957 subroutine set_shield_fac2
11958 implicit real*8 (a-h,o-z)
11959 include 'DIMENSIONS'
11960 include 'COMMON.CHAIN'
11961 include 'COMMON.DERIV'
11962 include 'COMMON.IOUNITS'
11963 include 'COMMON.SHIELD'
11964 include 'COMMON.INTERACT'
11965 include 'COMMON.LOCAL'
11967 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11968 double precision div77_81/0.974996043d0/,
11969 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11971 C the vector between center of side_chain and peptide group
11972 double precision pep_side(3),long,side_calf(3),
11973 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11974 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11975 C write(2,*) "ivec",ivec_start,ivec_end
11977 fac_shield(i)=0.0d0
11979 grad_shield(j,i)=0.0d0
11982 C the line belowe needs to be changed for FGPROC>1
11983 do i=ivec_start,ivec_end
11985 C if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11987 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11988 Cif there two consequtive dummy atoms there is no peptide group between them
11989 C the line below has to be changed for FGPROC>1
11992 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11996 C first lets set vector conecting the ithe side-chain with kth side-chain
11997 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11998 C pep_side(j)=2.0d0
11999 C and vector conecting the side-chain with its proper calfa
12000 side_calf(j)=c(j,k+nres)-c(j,k)
12001 C side_calf(j)=2.0d0
12002 pept_group(j)=c(j,i)-c(j,i+1)
12003 C lets have their lenght
12004 dist_pep_side=pep_side(j)**2+dist_pep_side
12005 dist_side_calf=dist_side_calf+side_calf(j)**2
12006 dist_pept_group=dist_pept_group+pept_group(j)**2
12008 dist_pep_side=dsqrt(dist_pep_side)
12009 dist_pept_group=dsqrt(dist_pept_group)
12010 dist_side_calf=dsqrt(dist_side_calf)
12012 pep_side_norm(j)=pep_side(j)/dist_pep_side
12013 side_calf_norm(j)=dist_side_calf
12015 C now sscale fraction
12016 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
12017 C print *,buff_shield,"buff"
12019 if (sh_frac_dist.le.0.0) cycle
12020 C print *,ishield_list(i),i
12021 C If we reach here it means that this side chain reaches the shielding sphere
12022 C Lets add him to the list for gradient
12023 ishield_list(i)=ishield_list(i)+1
12024 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
12025 C this list is essential otherwise problem would be O3
12026 shield_list(ishield_list(i),i)=k
12027 C Lets have the sscale value
12028 if (sh_frac_dist.gt.1.0) then
12029 scale_fac_dist=1.0d0
12031 sh_frac_dist_grad(j)=0.0d0
12034 scale_fac_dist=-sh_frac_dist*sh_frac_dist
12035 & *(2.0d0*sh_frac_dist-3.0d0)
12036 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
12037 & /dist_pep_side/buff_shield*0.5d0
12038 C remember for the final gradient multiply sh_frac_dist_grad(j)
12039 C for side_chain by factor -2 !
12041 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
12042 C sh_frac_dist_grad(j)=0.0d0
12043 C scale_fac_dist=1.0d0
12044 C print *,"jestem",scale_fac_dist,fac_help_scale,
12045 C & sh_frac_dist_grad(j)
12048 C this is what is now we have the distance scaling now volume...
12049 short=short_r_sidechain(itype(k))
12050 long=long_r_sidechain(itype(k))
12051 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
12052 sinthet=short/dist_pep_side*costhet
12056 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
12057 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
12058 C & -short/dist_pep_side**2/costhet)
12059 C costhet_fac=0.0d0
12061 costhet_grad(j)=costhet_fac*pep_side(j)
12063 C remember for the final gradient multiply costhet_grad(j)
12064 C for side_chain by factor -2 !
12065 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
12066 C pep_side0pept_group is vector multiplication
12067 pep_side0pept_group=0.0d0
12069 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
12071 cosalfa=(pep_side0pept_group/
12072 & (dist_pep_side*dist_side_calf))
12073 fac_alfa_sin=1.0d0-cosalfa**2
12074 fac_alfa_sin=dsqrt(fac_alfa_sin)
12075 rkprim=fac_alfa_sin*(long-short)+short
12079 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
12081 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
12082 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
12083 & dist_pep_side**2)
12086 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
12087 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
12088 &*(long-short)/fac_alfa_sin*cosalfa/
12089 &((dist_pep_side*dist_side_calf))*
12090 &((side_calf(j))-cosalfa*
12091 &((pep_side(j)/dist_pep_side)*dist_side_calf))
12092 C cosphi_grad_long(j)=0.0d0
12093 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
12094 &*(long-short)/fac_alfa_sin*cosalfa
12095 &/((dist_pep_side*dist_side_calf))*
12097 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
12098 C cosphi_grad_loc(j)=0.0d0
12100 C print *,sinphi,sinthet
12101 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
12104 C now the gradient...
12106 grad_shield(j,i)=grad_shield(j,i)
12107 C gradient po skalowaniu
12108 & +(sh_frac_dist_grad(j)*VofOverlap
12109 C gradient po costhet
12110 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
12111 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
12112 & sinphi/sinthet*costhet*costhet_grad(j)
12113 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
12115 C grad_shield_side is Cbeta sidechain gradient
12116 grad_shield_side(j,ishield_list(i),i)=
12117 & (sh_frac_dist_grad(j)*-2.0d0
12119 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
12120 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
12121 & sinphi/sinthet*costhet*costhet_grad(j)
12122 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
12125 grad_shield_loc(j,ishield_list(i),i)=
12126 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
12127 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
12128 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
12132 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
12134 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
12135 C write(2,*) "TOTAL VOLUME",i,itype(i),fac_shield(i)
12139 C-----------------------------------------------------------------------
12140 C-----------------------------------------------------------
12141 C This subroutine is to mimic the histone like structure but as well can be
12142 C utilizet to nanostructures (infinit) small modification has to be used to
12143 C make it finite (z gradient at the ends has to be changes as well as the x,y
12144 C gradient has to be modified at the ends
12145 C The energy function is Kihara potential
12146 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
12147 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
12148 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
12149 C simple Kihara potential
12150 subroutine calctube(Etube)
12151 implicit real*8 (a-h,o-z)
12152 include 'DIMENSIONS'
12153 include 'COMMON.GEO'
12154 include 'COMMON.VAR'
12155 include 'COMMON.LOCAL'
12156 include 'COMMON.CHAIN'
12157 include 'COMMON.DERIV'
12158 include 'COMMON.NAMES'
12159 include 'COMMON.INTERACT'
12160 include 'COMMON.IOUNITS'
12161 include 'COMMON.CALC'
12162 include 'COMMON.CONTROL'
12163 include 'COMMON.SPLITELE'
12164 include 'COMMON.SBRIDGE'
12165 double precision tub_r,vectube(3),enetube(maxres*2)
12167 do i=itube_start,itube_end
12169 enetube(i+nres)=0.0d0
12171 C first we calculate the distance from tube center
12172 C first sugare-phosphate group for NARES this would be peptide group
12174 do i=itube_start,itube_end
12175 C lets ommit dummy atoms for now
12176 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
12177 C now calculate distance from center of tube and direction vectors
12181 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
12182 vectube(1)=vectube(1)+boxxsize*j
12183 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
12184 vectube(2)=vectube(2)+boxysize*j
12186 xminact=abs(vectube(1)-tubecenter(1))
12187 yminact=abs(vectube(2)-tubecenter(2))
12188 if (xmin.gt.xminact) then
12192 if (ymin.gt.yminact) then
12199 vectube(1)=vectube(1)-tubecenter(1)
12200 vectube(2)=vectube(2)-tubecenter(2)
12202 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
12203 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
12205 C as the tube is infinity we do not calculate the Z-vector use of Z
12208 C now calculte the distance
12209 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12210 C now normalize vector
12211 vectube(1)=vectube(1)/tub_r
12212 vectube(2)=vectube(2)/tub_r
12213 C calculte rdiffrence between r and r0
12216 rdiff6=rdiff**6.0d0
12217 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12218 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
12219 C write(iout,*) "TU13",i,rdiff6,enetube(i)
12220 C print *,rdiff,rdiff6,pep_aa_tube
12221 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12222 C now we calculate gradient
12223 fac=(-12.0d0*pep_aa_tube/rdiff6-
12224 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
12225 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
12228 C now direction of gg_tube vector
12230 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
12231 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
12234 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
12235 C print *,gg_tube(1,0),"TU"
12238 do i=itube_start,itube_end
12239 C Lets not jump over memory as we use many times iti
12241 C lets ommit dummy atoms for now
12243 C in UNRES uncomment the line below as GLY has no side-chain...
12249 vectube(1)=mod((c(1,i+nres)),boxxsize)
12250 vectube(1)=vectube(1)+boxxsize*j
12251 vectube(2)=mod((c(2,i+nres)),boxysize)
12252 vectube(2)=vectube(2)+boxysize*j
12254 xminact=abs(vectube(1)-tubecenter(1))
12255 yminact=abs(vectube(2)-tubecenter(2))
12256 if (xmin.gt.xminact) then
12260 if (ymin.gt.yminact) then
12267 C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
12269 vectube(1)=vectube(1)-tubecenter(1)
12270 vectube(2)=vectube(2)-tubecenter(2)
12272 C as the tube is infinity we do not calculate the Z-vector use of Z
12275 C now calculte the distance
12276 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12277 C now normalize vector
12278 vectube(1)=vectube(1)/tub_r
12279 vectube(2)=vectube(2)/tub_r
12281 C calculte rdiffrence between r and r0
12284 rdiff6=rdiff**6.0d0
12285 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12286 sc_aa_tube=sc_aa_tube_par(iti)
12287 sc_bb_tube=sc_bb_tube_par(iti)
12288 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
12289 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12290 C now we calculate gradient
12291 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
12292 & 6.0d0*sc_bb_tube/rdiff6/rdiff
12293 C now direction of gg_tube vector
12295 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
12296 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
12299 do i=itube_start,itube_end
12300 Etube=Etube+enetube(i)+enetube(i+nres)
12302 C print *,"ETUBE", etube
12305 C TO DO 1) add to total energy
12306 C 2) add to gradient summation
12307 C 3) add reading parameters (AND of course oppening of PARAM file)
12308 C 4) add reading the center of tube
12310 C 6) add to zerograd
12312 C-----------------------------------------------------------------------
12313 C-----------------------------------------------------------
12314 C This subroutine is to mimic the histone like structure but as well can be
12315 C utilizet to nanostructures (infinit) small modification has to be used to
12316 C make it finite (z gradient at the ends has to be changes as well as the x,y
12317 C gradient has to be modified at the ends
12318 C The energy function is Kihara potential
12319 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
12320 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
12321 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
12322 C simple Kihara potential
12323 subroutine calctube2(Etube)
12324 implicit real*8 (a-h,o-z)
12325 include 'DIMENSIONS'
12326 include 'COMMON.GEO'
12327 include 'COMMON.VAR'
12328 include 'COMMON.LOCAL'
12329 include 'COMMON.CHAIN'
12330 include 'COMMON.DERIV'
12331 include 'COMMON.NAMES'
12332 include 'COMMON.INTERACT'
12333 include 'COMMON.IOUNITS'
12334 include 'COMMON.CALC'
12335 include 'COMMON.CONTROL'
12336 include 'COMMON.SPLITELE'
12337 include 'COMMON.SBRIDGE'
12338 double precision tub_r,vectube(3),enetube(maxres*2)
12340 do i=itube_start,itube_end
12342 enetube(i+nres)=0.0d0
12344 C first we calculate the distance from tube center
12345 C first sugare-phosphate group for NARES this would be peptide group
12347 do i=itube_start,itube_end
12348 C lets ommit dummy atoms for now
12350 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
12351 C now calculate distance from center of tube and direction vectors
12352 C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
12353 C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
12354 C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
12355 C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
12359 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
12360 vectube(1)=vectube(1)+boxxsize*j
12361 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
12362 vectube(2)=vectube(2)+boxysize*j
12364 xminact=abs(vectube(1)-tubecenter(1))
12365 yminact=abs(vectube(2)-tubecenter(2))
12366 if (xmin.gt.xminact) then
12370 if (ymin.gt.yminact) then
12377 vectube(1)=vectube(1)-tubecenter(1)
12378 vectube(2)=vectube(2)-tubecenter(2)
12380 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
12381 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
12383 C as the tube is infinity we do not calculate the Z-vector use of Z
12386 C now calculte the distance
12387 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12388 C now normalize vector
12389 vectube(1)=vectube(1)/tub_r
12390 vectube(2)=vectube(2)/tub_r
12391 C calculte rdiffrence between r and r0
12394 rdiff6=rdiff**6.0d0
12395 C THIS FRAGMENT MAKES TUBE FINITE
12396 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
12397 if (positi.le.0) positi=positi+boxzsize
12398 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
12399 c for each residue check if it is in lipid or lipid water border area
12400 C respos=mod(c(3,i+nres),boxzsize)
12401 print *,positi,bordtubebot,buftubebot,bordtubetop
12402 if ((positi.gt.bordtubebot)
12403 & .and.(positi.lt.bordtubetop)) then
12404 C the energy transfer exist
12405 if (positi.lt.buftubebot) then
12407 & ((positi-bordtubebot)/tubebufthick)
12408 C lipbufthick is thickenes of lipid buffore
12409 sstube=sscalelip(fracinbuf)
12410 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
12411 print *,ssgradtube, sstube,tubetranene(itype(i))
12412 enetube(i)=enetube(i)+sstube*tubetranenepep
12413 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
12414 C &+ssgradtube*tubetranene(itype(i))
12415 C gg_tube(3,i-1)= gg_tube(3,i-1)
12416 C &+ssgradtube*tubetranene(itype(i))
12417 C print *,"doing sccale for lower part"
12418 elseif (positi.gt.buftubetop) then
12420 &((bordtubetop-positi)/tubebufthick)
12421 sstube=sscalelip(fracinbuf)
12422 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
12423 enetube(i)=enetube(i)+sstube*tubetranenepep
12424 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
12425 C &+ssgradtube*tubetranene(itype(i))
12426 C gg_tube(3,i-1)= gg_tube(3,i-1)
12427 C &+ssgradtube*tubetranene(itype(i))
12428 C print *, "doing sscalefor top part",sslip,fracinbuf
12432 enetube(i)=enetube(i)+sstube*tubetranenepep
12433 C print *,"I am in true lipid"
12439 endif ! if in lipid or buffor
12441 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12442 enetube(i)=enetube(i)+sstube*
12443 &(pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
12444 C write(iout,*) "TU13",i,rdiff6,enetube(i)
12445 C print *,rdiff,rdiff6,pep_aa_tube
12446 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12447 C now we calculate gradient
12448 fac=(-12.0d0*pep_aa_tube/rdiff6-
12449 & 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
12450 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
12453 C now direction of gg_tube vector
12455 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
12456 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
12458 gg_tube(3,i)=gg_tube(3,i)
12459 &+ssgradtube*enetube(i)/sstube/2.0d0
12460 gg_tube(3,i-1)= gg_tube(3,i-1)
12461 &+ssgradtube*enetube(i)/sstube/2.0d0
12464 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
12465 C print *,gg_tube(1,0),"TU"
12466 do i=itube_start,itube_end
12467 C Lets not jump over memory as we use many times iti
12469 C lets ommit dummy atoms for now
12471 C in UNRES uncomment the line below as GLY has no side-chain...
12474 vectube(1)=c(1,i+nres)
12475 vectube(1)=mod(vectube(1),boxxsize)
12476 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
12477 vectube(2)=c(2,i+nres)
12478 vectube(2)=mod(vectube(2),boxysize)
12479 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
12481 vectube(1)=vectube(1)-tubecenter(1)
12482 vectube(2)=vectube(2)-tubecenter(2)
12483 C THIS FRAGMENT MAKES TUBE FINITE
12484 positi=(mod(c(3,i+nres),boxzsize))
12485 if (positi.le.0) positi=positi+boxzsize
12486 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
12487 c for each residue check if it is in lipid or lipid water border area
12488 C respos=mod(c(3,i+nres),boxzsize)
12489 print *,positi,bordtubebot,buftubebot,bordtubetop
12490 if ((positi.gt.bordtubebot)
12491 & .and.(positi.lt.bordtubetop)) then
12492 C the energy transfer exist
12493 if (positi.lt.buftubebot) then
12495 & ((positi-bordtubebot)/tubebufthick)
12496 C lipbufthick is thickenes of lipid buffore
12497 sstube=sscalelip(fracinbuf)
12498 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
12499 print *,ssgradtube, sstube,tubetranene(itype(i))
12500 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
12501 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
12502 C &+ssgradtube*tubetranene(itype(i))
12503 C gg_tube(3,i-1)= gg_tube(3,i-1)
12504 C &+ssgradtube*tubetranene(itype(i))
12505 C print *,"doing sccale for lower part"
12506 elseif (positi.gt.buftubetop) then
12508 &((bordtubetop-positi)/tubebufthick)
12509 sstube=sscalelip(fracinbuf)
12510 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
12511 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
12512 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
12513 C &+ssgradtube*tubetranene(itype(i))
12514 C gg_tube(3,i-1)= gg_tube(3,i-1)
12515 C &+ssgradtube*tubetranene(itype(i))
12516 C print *, "doing sscalefor top part",sslip,fracinbuf
12520 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
12521 C print *,"I am in true lipid"
12527 endif ! if in lipid or buffor
12528 CEND OF FINITE FRAGMENT
12529 C as the tube is infinity we do not calculate the Z-vector use of Z
12532 C now calculte the distance
12533 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12534 C now normalize vector
12535 vectube(1)=vectube(1)/tub_r
12536 vectube(2)=vectube(2)/tub_r
12537 C calculte rdiffrence between r and r0
12540 rdiff6=rdiff**6.0d0
12541 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12542 sc_aa_tube=sc_aa_tube_par(iti)
12543 sc_bb_tube=sc_bb_tube_par(iti)
12544 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)
12545 & *sstube+enetube(i+nres)
12546 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12547 C now we calculate gradient
12548 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
12549 & 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
12550 C now direction of gg_tube vector
12552 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
12553 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
12555 gg_tube_SC(3,i)=gg_tube_SC(3,i)
12556 &+ssgradtube*enetube(i+nres)/sstube
12557 gg_tube(3,i-1)= gg_tube(3,i-1)
12558 &+ssgradtube*enetube(i+nres)/sstube
12561 do i=itube_start,itube_end
12562 Etube=Etube+enetube(i)+enetube(i+nres)
12564 C print *,"ETUBE", etube
12567 C TO DO 1) add to total energy
12568 C 2) add to gradient summation
12569 C 3) add reading parameters (AND of course oppening of PARAM file)
12570 C 4) add reading the center of tube
12572 C 6) add to zerograd
12575 C#-------------------------------------------------------------------------------
12576 C This subroutine is to mimic the histone like structure but as well can be
12577 C utilizet to nanostructures (infinit) small modification has to be used to
12578 C make it finite (z gradient at the ends has to be changes as well as the x,y
12579 C gradient has to be modified at the ends
12580 C The energy function is Kihara potential
12581 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
12582 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
12583 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
12584 C simple Kihara potential
12585 subroutine calcnano(Etube)
12586 implicit real*8 (a-h,o-z)
12587 include 'DIMENSIONS'
12588 include 'COMMON.GEO'
12589 include 'COMMON.VAR'
12590 include 'COMMON.LOCAL'
12591 include 'COMMON.CHAIN'
12592 include 'COMMON.DERIV'
12593 include 'COMMON.NAMES'
12594 include 'COMMON.INTERACT'
12595 include 'COMMON.IOUNITS'
12596 include 'COMMON.CALC'
12597 include 'COMMON.CONTROL'
12598 include 'COMMON.SPLITELE'
12599 include 'COMMON.SBRIDGE'
12600 double precision tub_r,vectube(3),enetube(maxres*2),
12601 & enecavtube(maxres*2)
12603 do i=itube_start,itube_end
12605 enetube(i+nres)=0.0d0
12607 C first we calculate the distance from tube center
12608 C first sugare-phosphate group for NARES this would be peptide group
12610 do i=itube_start,itube_end
12611 C lets ommit dummy atoms for now
12612 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
12613 C now calculate distance from center of tube and direction vectors
12619 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
12620 vectube(1)=vectube(1)+boxxsize*j
12621 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
12622 vectube(2)=vectube(2)+boxysize*j
12623 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
12624 vectube(3)=vectube(3)+boxzsize*j
12627 xminact=dabs(vectube(1)-tubecenter(1))
12628 yminact=dabs(vectube(2)-tubecenter(2))
12629 zminact=dabs(vectube(3)-tubecenter(3))
12631 if (xmin.gt.xminact) then
12635 if (ymin.gt.yminact) then
12639 if (zmin.gt.zminact) then
12648 vectube(1)=vectube(1)-tubecenter(1)
12649 vectube(2)=vectube(2)-tubecenter(2)
12650 vectube(3)=vectube(3)-tubecenter(3)
12652 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
12653 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
12654 C as the tube is infinity we do not calculate the Z-vector use of Z
12657 C now calculte the distance
12658 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12659 C now normalize vector
12660 vectube(1)=vectube(1)/tub_r
12661 vectube(2)=vectube(2)/tub_r
12662 vectube(3)=vectube(3)/tub_r
12663 C calculte rdiffrence between r and r0
12666 rdiff6=rdiff**6.0d0
12667 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12668 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
12669 C write(iout,*) "TU13",i,rdiff6,enetube(i)
12670 C print *,rdiff,rdiff6,pep_aa_tube
12671 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12672 C now we calculate gradient
12673 fac=(-12.0d0*pep_aa_tube/rdiff6-
12674 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
12675 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
12677 if (acavtubpep.eq.0.0d0) then
12682 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
12684 & (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep)
12687 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff))
12688 & *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)
12689 & +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0)
12690 & /denominator**2.0d0
12695 C print *,"TUT",i,iti,rdiff,rdiff6,acavtubpep,denominator,
12696 C & enecavtube(i),faccav
12698 C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
12699 CX print *,"finene=",enetube(i+nres)+enecavtube(i)
12701 C now direction of gg_tube vector
12703 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
12704 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
12708 do i=itube_start,itube_end
12709 enecavtube(i)=0.0d0
12710 C Lets not jump over memory as we use many times iti
12712 C lets ommit dummy atoms for now
12714 C in UNRES uncomment the line below as GLY has no side-chain...
12721 vectube(1)=dmod((c(1,i+nres)),boxxsize)
12722 vectube(1)=vectube(1)+boxxsize*j
12723 vectube(2)=dmod((c(2,i+nres)),boxysize)
12724 vectube(2)=vectube(2)+boxysize*j
12725 vectube(3)=dmod((c(3,i+nres)),boxzsize)
12726 vectube(3)=vectube(3)+boxzsize*j
12729 xminact=dabs(vectube(1)-tubecenter(1))
12730 yminact=dabs(vectube(2)-tubecenter(2))
12731 zminact=dabs(vectube(3)-tubecenter(3))
12733 if (xmin.gt.xminact) then
12737 if (ymin.gt.yminact) then
12741 if (zmin.gt.zminact) then
12750 C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
12752 vectube(1)=vectube(1)-tubecenter(1)
12753 vectube(2)=vectube(2)-tubecenter(2)
12754 vectube(3)=vectube(3)-tubecenter(3)
12755 C now calculte the distance
12756 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12757 C now normalize vector
12758 vectube(1)=vectube(1)/tub_r
12759 vectube(2)=vectube(2)/tub_r
12760 vectube(3)=vectube(3)/tub_r
12762 C calculte rdiffrence between r and r0
12765 rdiff6=rdiff**6.0d0
12766 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12767 sc_aa_tube=sc_aa_tube_par(iti)
12768 sc_bb_tube=sc_bb_tube_par(iti)
12769 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
12770 C enetube(i+nres)=0.0d0
12771 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12772 C now we calculate gradient
12773 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
12774 & 6.0d0*sc_bb_tube/rdiff6/rdiff
12776 C now direction of gg_tube vector
12777 C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
12778 if (acavtub(iti).eq.0.0d0) then
12780 enecavtube(i+nres)=0.0d0
12783 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
12784 enecavtube(i+nres)=
12785 & (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti))
12787 C enecavtube(i)=0.0
12788 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff))
12789 & *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)
12790 & +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0)
12791 & /denominator**2.0d0
12796 C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
12797 C & enecavtube(i),faccav
12799 C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
12800 C print *,"finene=",enetube(i+nres)+enecavtube(i)
12802 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
12803 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
12806 C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
12807 C do i=itube_start,itube_end
12810 C if (acavtub(iti).eq.0.0) cycle
12814 do i=itube_start,itube_end
12815 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i)
12816 & +enecavtube(i+nres)
12818 C print *,"ETUBE", etube
12821 C TO DO 1) add to total energy
12822 C 2) add to gradient summation
12823 C 3) add reading parameters (AND of course oppening of PARAM file)
12824 C 4) add reading the center of tube
12826 C 6) add to zerograd