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 C 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 C print *,'Calling EHPB'
286 C 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
5130 c ghalf1=0.5d0*agg(l,1)
5131 c ghalf2=0.5d0*agg(l,2)
5132 c ghalf3=0.5d0*agg(l,3)
5133 c ghalf4=0.5d0*agg(l,4)
5134 a_temp(1,1)=aggi(l,1)!+ghalf1
5135 a_temp(1,2)=aggi(l,2)!+ghalf2
5136 a_temp(2,1)=aggi(l,3)!+ghalf3
5137 a_temp(2,2)=aggi(l,4)!+ghalf4
5138 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5139 gcorr3_turn(l,i)=gcorr3_turn(l,i)
5140 & +0.5d0*(pizda(1,1)+pizda(2,2))
5141 & *fac_shield(i)*fac_shield(j)
5142 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5144 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
5145 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
5146 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
5147 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
5148 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5149 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
5150 & +0.5d0*(pizda(1,1)+pizda(2,2))
5151 & *fac_shield(i)*fac_shield(j)
5152 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5153 a_temp(1,1)=aggj(l,1)!+ghalf1
5154 a_temp(1,2)=aggj(l,2)!+ghalf2
5155 a_temp(2,1)=aggj(l,3)!+ghalf3
5156 a_temp(2,2)=aggj(l,4)!+ghalf4
5157 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5158 gcorr3_turn(l,j)=gcorr3_turn(l,j)
5159 & +0.5d0*(pizda(1,1)+pizda(2,2))
5160 & *fac_shield(i)*fac_shield(j)
5161 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5163 a_temp(1,1)=aggj1(l,1)
5164 a_temp(1,2)=aggj1(l,2)
5165 a_temp(2,1)=aggj1(l,3)
5166 a_temp(2,2)=aggj1(l,4)
5167 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5168 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
5169 & +0.5d0*(pizda(1,1)+pizda(2,2))
5170 & *fac_shield(i)*fac_shield(j)
5171 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5173 gshieldc_t3(3,i)=gshieldc_t3(3,i)+
5174 & ssgradlipi*eello_t3/4.0d0*lipscale
5175 gshieldc_t3(3,j)=gshieldc_t3(3,j)+
5176 & ssgradlipj*eello_t3/4.0d0*lipscale
5177 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+
5178 & ssgradlipi*eello_t3/4.0d0*lipscale
5179 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+
5180 & ssgradlipj*eello_t3/4.0d0*lipscale
5182 C print *,ssgradlipi,ssgradlipj,eello_t3,sslipi,sslipj
5185 C-------------------------------------------------------------------------------
5186 subroutine eturn4(i,eello_turn4)
5187 C Third- and fourth-order contributions from turns
5188 implicit real*8 (a-h,o-z)
5189 include 'DIMENSIONS'
5190 include 'COMMON.IOUNITS'
5191 include 'COMMON.GEO'
5192 include 'COMMON.VAR'
5193 include 'COMMON.LOCAL'
5194 include 'COMMON.CHAIN'
5195 include 'COMMON.DERIV'
5196 include 'COMMON.INTERACT'
5197 include 'COMMON.CONTACTS'
5198 include 'COMMON.TORSION'
5199 include 'COMMON.VECTORS'
5200 include 'COMMON.FFIELD'
5201 include 'COMMON.CONTROL'
5202 include 'COMMON.SHIELD'
5204 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
5205 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
5206 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
5207 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
5208 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
5209 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
5210 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
5211 double precision agg(3,4),aggi(3,4),aggi1(3,4),
5212 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
5213 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
5214 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
5217 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5219 C Fourth-order contributions
5227 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5228 cd call checkint_turn4(i,a_temp,eello_turn4_num)
5229 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
5230 c write(iout,*)"WCHODZE W PROGRAM"
5231 zj=(c(3,j)+c(3,j+1))/2.0d0
5232 C xj=mod(xj,boxxsize)
5233 C if (xj.lt.0) xj=xj+boxxsize
5234 C yj=mod(yj,boxysize)
5235 C if (yj.lt.0) yj=yj+boxysize
5237 if (zj.lt.0) zj=zj+boxzsize
5238 C if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
5239 if ((zj.gt.bordlipbot)
5240 &.and.(zj.lt.bordliptop)) then
5241 C the energy transfer exist
5242 if (zj.lt.buflipbot) then
5243 C what fraction I am in
5245 & ((zj-bordlipbot)/lipbufthick)
5246 C lipbufthick is thickenes of lipid buffore
5247 sslipj=sscalelip(fracinbuf)
5248 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
5249 elseif (zj.gt.bufliptop) then
5250 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
5251 sslipj=sscalelip(fracinbuf)
5252 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
5266 iti1=itype2loc(itype(i+1))
5267 iti2=itype2loc(itype(i+2))
5268 iti3=itype2loc(itype(i+3))
5269 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
5270 call transpose2(EUg(1,1,i+1),e1t(1,1))
5271 call transpose2(Eug(1,1,i+2),e2t(1,1))
5272 call transpose2(Eug(1,1,i+3),e3t(1,1))
5273 C Ematrix derivative in theta
5274 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
5275 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
5276 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
5277 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5278 c eta1 in derivative theta
5279 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
5280 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5281 c auxgvec is derivative of Ub2 so i+3 theta
5282 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
5283 c auxalary matrix of E i+1
5284 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
5287 s1=scalar2(b1(1,i+2),auxvec(1))
5288 c derivative of theta i+2 with constant i+3
5289 gs23=scalar2(gtb1(1,i+2),auxvec(1))
5290 c derivative of theta i+2 with constant i+2
5291 gs32=scalar2(b1(1,i+2),auxgvec(1))
5292 c derivative of E matix in theta of i+1
5293 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
5295 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5296 c ea31 in derivative theta
5297 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
5298 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5299 c auxilary matrix auxgvec of Ub2 with constant E matirx
5300 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
5301 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
5302 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
5306 s2=scalar2(b1(1,i+1),auxvec(1))
5307 c derivative of theta i+1 with constant i+3
5308 gs13=scalar2(gtb1(1,i+1),auxvec(1))
5309 c derivative of theta i+2 with constant i+1
5310 gs21=scalar2(b1(1,i+1),auxgvec(1))
5311 c derivative of theta i+3 with constant i+1
5312 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
5313 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
5315 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5316 c two derivatives over diffetent matrices
5317 c gtae3e2 is derivative over i+3
5318 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
5319 c ae3gte2 is derivative over i+2
5320 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
5321 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5322 c three possible derivative over theta E matices
5324 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
5326 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
5328 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
5329 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5331 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
5332 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
5333 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
5334 if (shield_mode.eq.0) then
5341 eello_turn4=eello_turn4-(s1+s2+s3)
5342 & *fac_shield(i)*fac_shield(j)
5343 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5345 eello_t4=-(s1+s2+s3)
5346 & *fac_shield(i)*fac_shield(j)
5347 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
5348 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
5349 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
5350 C Now derivative over shield:
5351 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
5352 & (shield_mode.gt.0)) then
5355 do ilist=1,ishield_list(i)
5356 iresshield=shield_list(ilist,i)
5358 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
5360 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
5362 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
5363 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
5367 do ilist=1,ishield_list(j)
5368 iresshield=shield_list(ilist,j)
5370 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
5372 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
5374 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
5375 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
5382 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
5383 & grad_shield(k,i)*eello_t4/fac_shield(i)
5384 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
5385 & grad_shield(k,j)*eello_t4/fac_shield(j)
5386 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
5387 & grad_shield(k,i)*eello_t4/fac_shield(i)
5388 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
5389 & grad_shield(k,j)*eello_t4/fac_shield(j)
5398 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5399 cd & ' eello_turn4_num',8*eello_turn4_num
5401 gloc(nphi+i,icg)=gloc(nphi+i,icg)
5402 & -(gs13+gsE13+gsEE1)*wturn4
5403 & *fac_shield(i)*fac_shield(j)
5404 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5406 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
5407 & -(gs23+gs21+gsEE2)*wturn4
5408 & *fac_shield(i)*fac_shield(j)
5409 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5411 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
5412 & -(gs32+gsE31+gsEE3)*wturn4
5413 & *fac_shield(i)*fac_shield(j)
5414 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5416 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
5419 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5420 & 'eturn4',i,j,-(s1+s2+s3)
5421 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5422 c & ' eello_turn4_num',8*eello_turn4_num
5423 C Derivatives in gamma(i)
5424 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
5425 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
5426 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
5427 s1=scalar2(b1(1,i+2),auxvec(1))
5428 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
5429 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5430 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
5431 & *fac_shield(i)*fac_shield(j)
5432 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5434 C Derivatives in gamma(i+1)
5435 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
5436 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
5437 s2=scalar2(b1(1,i+1),auxvec(1))
5438 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5439 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5440 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5441 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
5442 & *fac_shield(i)*fac_shield(j)
5443 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5445 C Derivatives in gamma(i+2)
5446 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5447 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5448 s1=scalar2(b1(1,i+2),auxvec(1))
5449 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5450 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5451 s2=scalar2(b1(1,i+1),auxvec(1))
5452 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5453 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5454 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5455 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
5456 & *fac_shield(i)*fac_shield(j)
5457 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5459 C Cartesian derivatives
5460 C Derivatives of this turn contributions in DC(i+2)
5461 if (j.lt.nres-1) then
5463 a_temp(1,1)=agg(l,1)
5464 a_temp(1,2)=agg(l,2)
5465 a_temp(2,1)=agg(l,3)
5466 a_temp(2,2)=agg(l,4)
5467 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5468 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5469 s1=scalar2(b1(1,i+2),auxvec(1))
5470 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5471 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5472 s2=scalar2(b1(1,i+1),auxvec(1))
5473 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5474 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5475 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5477 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
5478 & *fac_shield(i)*fac_shield(j)
5479 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5483 C Remaining derivatives of this turn contribution
5485 a_temp(1,1)=aggi(l,1)
5486 a_temp(1,2)=aggi(l,2)
5487 a_temp(2,1)=aggi(l,3)
5488 a_temp(2,2)=aggi(l,4)
5489 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5490 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5491 s1=scalar2(b1(1,i+2),auxvec(1))
5492 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5493 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5494 s2=scalar2(b1(1,i+1),auxvec(1))
5495 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5496 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5497 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5498 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
5499 & *fac_shield(i)*fac_shield(j)
5500 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5502 a_temp(1,1)=aggi1(l,1)
5503 a_temp(1,2)=aggi1(l,2)
5504 a_temp(2,1)=aggi1(l,3)
5505 a_temp(2,2)=aggi1(l,4)
5506 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5507 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5508 s1=scalar2(b1(1,i+2),auxvec(1))
5509 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5510 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5511 s2=scalar2(b1(1,i+1),auxvec(1))
5512 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5513 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5514 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5515 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
5516 & *fac_shield(i)*fac_shield(j)
5517 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5519 a_temp(1,1)=aggj(l,1)
5520 a_temp(1,2)=aggj(l,2)
5521 a_temp(2,1)=aggj(l,3)
5522 a_temp(2,2)=aggj(l,4)
5523 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5524 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5525 s1=scalar2(b1(1,i+2),auxvec(1))
5526 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5527 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5528 s2=scalar2(b1(1,i+1),auxvec(1))
5529 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5530 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5531 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5532 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
5533 & *fac_shield(i)*fac_shield(j)
5534 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5536 a_temp(1,1)=aggj1(l,1)
5537 a_temp(1,2)=aggj1(l,2)
5538 a_temp(2,1)=aggj1(l,3)
5539 a_temp(2,2)=aggj1(l,4)
5540 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5541 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5542 s1=scalar2(b1(1,i+2),auxvec(1))
5543 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5544 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5545 s2=scalar2(b1(1,i+1),auxvec(1))
5546 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5547 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5548 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5549 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5550 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
5551 & *fac_shield(i)*fac_shield(j)
5552 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5554 gshieldc_t4(3,i)=gshieldc_t4(3,i)+
5555 & ssgradlipi*eello_t4/4.0d0*lipscale
5556 gshieldc_t4(3,j)=gshieldc_t4(3,j)+
5557 & ssgradlipj*eello_t4/4.0d0*lipscale
5558 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+
5559 & ssgradlipi*eello_t4/4.0d0*lipscale
5560 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+
5561 & ssgradlipj*eello_t4/4.0d0*lipscale
5564 C-----------------------------------------------------------------------------
5565 subroutine vecpr(u,v,w)
5566 implicit real*8(a-h,o-z)
5567 dimension u(3),v(3),w(3)
5568 w(1)=u(2)*v(3)-u(3)*v(2)
5569 w(2)=-u(1)*v(3)+u(3)*v(1)
5570 w(3)=u(1)*v(2)-u(2)*v(1)
5573 C-----------------------------------------------------------------------------
5574 subroutine unormderiv(u,ugrad,unorm,ungrad)
5575 C This subroutine computes the derivatives of a normalized vector u, given
5576 C the derivatives computed without normalization conditions, ugrad. Returns
5579 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
5580 double precision vec(3)
5581 double precision scalar
5583 c write (2,*) 'ugrad',ugrad
5586 vec(i)=scalar(ugrad(1,i),u(1))
5588 c write (2,*) 'vec',vec
5591 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5594 c write (2,*) 'ungrad',ungrad
5597 C-----------------------------------------------------------------------------
5598 subroutine escp_soft_sphere(evdw2,evdw2_14)
5600 C This subroutine calculates the excluded-volume interaction energy between
5601 C peptide-group centers and side chains and its gradient in virtual-bond and
5602 C side-chain vectors.
5604 implicit real*8 (a-h,o-z)
5605 include 'DIMENSIONS'
5606 include 'COMMON.GEO'
5607 include 'COMMON.VAR'
5608 include 'COMMON.LOCAL'
5609 include 'COMMON.CHAIN'
5610 include 'COMMON.DERIV'
5611 include 'COMMON.INTERACT'
5612 include 'COMMON.FFIELD'
5613 include 'COMMON.IOUNITS'
5614 include 'COMMON.CONTROL'
5619 cd print '(a)','Enter ESCP'
5620 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5624 do i=iatscp_s,iatscp_e
5625 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5627 xi=0.5D0*(c(1,i)+c(1,i+1))
5628 yi=0.5D0*(c(2,i)+c(2,i+1))
5629 zi=0.5D0*(c(3,i)+c(3,i+1))
5630 C Return atom into box, boxxsize is size of box in x dimension
5632 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5633 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5634 C Condition for being inside the proper box
5635 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5636 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5640 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5641 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5642 C Condition for being inside the proper box
5643 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5644 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5648 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5649 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5650 cC Condition for being inside the proper box
5651 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5652 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5656 if (xi.lt.0) xi=xi+boxxsize
5658 if (yi.lt.0) yi=yi+boxysize
5660 if (zi.lt.0) zi=zi+boxzsize
5661 C xi=xi+xshift*boxxsize
5662 C yi=yi+yshift*boxysize
5663 C zi=zi+zshift*boxzsize
5664 do iint=1,nscp_gr(i)
5666 do j=iscpstart(i,iint),iscpend(i,iint)
5667 if (itype(j).eq.ntyp1) cycle
5668 itypj=iabs(itype(j))
5669 C Uncomment following three lines for SC-p interactions
5673 C Uncomment following three lines for Ca-p interactions
5678 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5679 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5680 C Condition for being inside the proper box
5681 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5682 c & (xj.lt.((-0.5d0)*boxxsize))) then
5686 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5687 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5688 cC Condition for being inside the proper box
5689 c if ((yj.gt.((0.5d0)*boxysize)).or.
5690 c & (yj.lt.((-0.5d0)*boxysize))) then
5694 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5695 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5696 C Condition for being inside the proper box
5697 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5698 c & (zj.lt.((-0.5d0)*boxzsize))) then
5701 if (xj.lt.0) xj=xj+boxxsize
5703 if (yj.lt.0) yj=yj+boxysize
5705 if (zj.lt.0) zj=zj+boxzsize
5706 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5714 xj=xj_safe+xshift*boxxsize
5715 yj=yj_safe+yshift*boxysize
5716 zj=zj_safe+zshift*boxzsize
5717 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5718 if(dist_temp.lt.dist_init) then
5728 if (subchap.eq.1) then
5741 rij=xj*xj+yj*yj+zj*zj
5745 if (rij.lt.r0ijsq) then
5746 evdwij=0.25d0*(rij-r0ijsq)**2
5754 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5759 cgrad if (j.lt.i) then
5760 cd write (iout,*) 'j<i'
5761 C Uncomment following three lines for SC-p interactions
5763 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5766 cd write (iout,*) 'j>i'
5768 cgrad ggg(k)=-ggg(k)
5769 C Uncomment following line for SC-p interactions
5770 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5774 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5776 cgrad kstart=min0(i+1,j)
5777 cgrad kend=max0(i-1,j-1)
5778 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5779 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5780 cgrad do k=kstart,kend
5782 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5786 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5787 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5798 C-----------------------------------------------------------------------------
5799 subroutine escp(evdw2,evdw2_14)
5801 C This subroutine calculates the excluded-volume interaction energy between
5802 C peptide-group centers and side chains and its gradient in virtual-bond and
5803 C side-chain vectors.
5805 implicit real*8 (a-h,o-z)
5806 include 'DIMENSIONS'
5807 include 'COMMON.GEO'
5808 include 'COMMON.VAR'
5809 include 'COMMON.LOCAL'
5810 include 'COMMON.CHAIN'
5811 include 'COMMON.DERIV'
5812 include 'COMMON.INTERACT'
5813 include 'COMMON.FFIELD'
5814 include 'COMMON.IOUNITS'
5815 include 'COMMON.CONTROL'
5816 include 'COMMON.SPLITELE'
5818 integer xshift,yshift,zshift
5821 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
5822 cd print '(a)','Enter ESCP'
5823 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5827 do i=iatscp_s,iatscp_e
5828 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5830 xi=0.5D0*(c(1,i)+c(1,i+1))
5831 yi=0.5D0*(c(2,i)+c(2,i+1))
5832 zi=0.5D0*(c(3,i)+c(3,i+1))
5834 if (xi.lt.0) xi=xi+boxxsize
5836 if (yi.lt.0) yi=yi+boxysize
5838 if (zi.lt.0) zi=zi+boxzsize
5839 c xi=xi+xshift*boxxsize
5840 c yi=yi+yshift*boxysize
5841 c zi=zi+zshift*boxzsize
5842 c print *,xi,yi,zi,'polozenie i'
5843 C Return atom into box, boxxsize is size of box in x dimension
5845 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5846 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5847 C Condition for being inside the proper box
5848 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5849 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5853 c print *,xi,boxxsize,"pierwszy"
5855 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5856 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5857 C Condition for being inside the proper box
5858 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5859 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5863 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5864 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5865 C Condition for being inside the proper box
5866 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5867 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5870 do iint=1,nscp_gr(i)
5872 do j=iscpstart(i,iint),iscpend(i,iint)
5873 itypj=iabs(itype(j))
5874 if (itypj.eq.ntyp1) cycle
5875 C Uncomment following three lines for SC-p interactions
5879 C Uncomment following three lines for Ca-p interactions
5884 if (xj.lt.0) xj=xj+boxxsize
5886 if (yj.lt.0) yj=yj+boxysize
5888 if (zj.lt.0) zj=zj+boxzsize
5890 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5891 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5892 C Condition for being inside the proper box
5893 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5894 c & (xj.lt.((-0.5d0)*boxxsize))) then
5898 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5899 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5900 cC Condition for being inside the proper box
5901 c if ((yj.gt.((0.5d0)*boxysize)).or.
5902 c & (yj.lt.((-0.5d0)*boxysize))) then
5906 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5907 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5908 C Condition for being inside the proper box
5909 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5910 c & (zj.lt.((-0.5d0)*boxzsize))) then
5913 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5914 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5922 xj=xj_safe+xshift*boxxsize
5923 yj=yj_safe+yshift*boxysize
5924 zj=zj_safe+zshift*boxzsize
5925 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5926 if(dist_temp.lt.dist_init) then
5936 if (subchap.eq.1) then
5945 c print *,xj,yj,zj,'polozenie j'
5946 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5948 sss=sscale(1.0d0/(dsqrt(rrij)))
5949 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5950 c if (sss.eq.0) print *,'czasem jest OK'
5951 if (sss.le.0.0d0) cycle
5952 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5954 e1=fac*fac*aad(itypj,iteli)
5955 e2=fac*bad(itypj,iteli)
5956 if (iabs(j-i) .le. 2) then
5959 evdw2_14=evdw2_14+(e1+e2)*sss
5962 evdw2=evdw2+evdwij*sss
5963 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5964 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5967 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5969 fac=-(evdwij+e1)*rrij*sss
5970 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5974 cgrad if (j.lt.i) then
5975 cd write (iout,*) 'j<i'
5976 C Uncomment following three lines for SC-p interactions
5978 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5981 cd write (iout,*) 'j>i'
5983 cgrad ggg(k)=-ggg(k)
5984 C Uncomment following line for SC-p interactions
5985 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5986 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5990 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5992 cgrad kstart=min0(i+1,j)
5993 cgrad kend=max0(i-1,j-1)
5994 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5995 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5996 cgrad do k=kstart,kend
5998 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
6002 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
6003 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
6005 c endif !endif for sscale cutoff
6015 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
6016 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
6017 gradx_scp(j,i)=expon*gradx_scp(j,i)
6020 C******************************************************************************
6024 C To save time the factor EXPON has been extracted from ALL components
6025 C of GVDWC and GRADX. Remember to multiply them by this factor before further
6028 C******************************************************************************
6031 C--------------------------------------------------------------------------
6032 subroutine edis(ehpb)
6034 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
6036 implicit real*8 (a-h,o-z)
6037 include 'DIMENSIONS'
6038 include 'COMMON.SBRIDGE'
6039 include 'COMMON.CHAIN'
6040 include 'COMMON.DERIV'
6041 include 'COMMON.VAR'
6042 include 'COMMON.INTERACT'
6043 include 'COMMON.IOUNITS'
6044 include 'COMMON.CONTROL'
6050 C write (iout,*) ,"link_end",link_end,constr_dist
6051 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
6052 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
6053 if (link_end.eq.0) return
6054 do i=link_start,link_end
6055 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
6056 C CA-CA distance used in regularization of structure.
6059 C iii and jjj point to the residues for which the distance is assigned.
6060 if (ii.gt.nres) then
6067 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
6068 c & dhpb(i),dhpb1(i),forcon(i)
6069 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
6070 C distance and angle dependent SS bond potential.
6071 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
6072 C & iabs(itype(jjj)).eq.1) then
6073 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
6074 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
6075 if (.not.dyn_ss .and. i.le.nss) then
6076 C 15/02/13 CC dynamic SSbond - additional check
6077 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
6078 & iabs(itype(jjj)).eq.1) then
6079 call ssbond_ene(iii,jjj,eij)
6082 cd write (iout,*) "eij",eij
6083 cd & ' waga=',waga,' fac=',fac
6084 else if (ii.gt.nres .and. jj.gt.nres) then
6085 c Restraints from contact prediction
6087 if (constr_dist.eq.11) then
6088 ehpb=ehpb+fordepth(i)**4.0d0
6089 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
6090 fac=fordepth(i)**4.0d0
6091 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
6092 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
6093 & ehpb,fordepth(i),dd
6095 if (dhpb1(i).gt.0.0d0) then
6096 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6097 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
6098 c write (iout,*) "beta nmr",
6099 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6103 C Get the force constant corresponding to this distance.
6105 C Calculate the contribution to energy.
6106 ehpb=ehpb+waga*rdis*rdis
6107 c write (iout,*) "beta reg",dd,waga*rdis*rdis
6109 C Evaluate gradient.
6115 ggg(j)=fac*(c(j,jj)-c(j,ii))
6118 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
6119 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
6122 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
6123 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
6126 C Calculate the distance between the two points and its difference from the
6129 if (constr_dist.eq.11) then
6130 ehpb=ehpb+fordepth(i)**4.0d0
6131 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
6132 fac=fordepth(i)**4.0d0
6133 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
6134 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
6135 & ehpb,fordepth(i),dd
6137 if (dhpb1(i).gt.0.0d0) then
6138 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6139 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
6140 c write (iout,*) "alph nmr",
6141 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6144 C Get the force constant corresponding to this distance.
6146 C Calculate the contribution to energy.
6147 ehpb=ehpb+waga*rdis*rdis
6148 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
6150 C Evaluate gradient.
6156 ggg(j)=fac*(c(j,jj)-c(j,ii))
6158 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
6159 C If this is a SC-SC distance, we need to calculate the contributions to the
6160 C Cartesian gradient in the SC vectors (ghpbx).
6163 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
6164 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
6167 cgrad do j=iii,jjj-1
6169 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
6173 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
6174 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
6178 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
6181 C--------------------------------------------------------------------------
6182 subroutine ssbond_ene(i,j,eij)
6184 C Calculate the distance and angle dependent SS-bond potential energy
6185 C using a free-energy function derived based on RHF/6-31G** ab initio
6186 C calculations of diethyl disulfide.
6188 C A. Liwo and U. Kozlowska, 11/24/03
6190 implicit real*8 (a-h,o-z)
6191 include 'DIMENSIONS'
6192 include 'COMMON.SBRIDGE'
6193 include 'COMMON.CHAIN'
6194 include 'COMMON.DERIV'
6195 include 'COMMON.LOCAL'
6196 include 'COMMON.INTERACT'
6197 include 'COMMON.VAR'
6198 include 'COMMON.IOUNITS'
6199 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
6200 itypi=iabs(itype(i))
6204 dxi=dc_norm(1,nres+i)
6205 dyi=dc_norm(2,nres+i)
6206 dzi=dc_norm(3,nres+i)
6207 c dsci_inv=dsc_inv(itypi)
6208 dsci_inv=vbld_inv(nres+i)
6209 itypj=iabs(itype(j))
6210 c dscj_inv=dsc_inv(itypj)
6211 dscj_inv=vbld_inv(nres+j)
6215 dxj=dc_norm(1,nres+j)
6216 dyj=dc_norm(2,nres+j)
6217 dzj=dc_norm(3,nres+j)
6218 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
6223 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
6224 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
6225 om12=dxi*dxj+dyi*dyj+dzi*dzj
6227 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
6228 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
6234 deltat12=om2-om1+2.0d0
6236 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
6237 & +akct*deltad*deltat12
6238 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
6239 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
6240 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
6241 c & " deltat12",deltat12," eij",eij
6242 ed=2*akcm*deltad+akct*deltat12
6244 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
6245 eom1=-2*akth*deltat1-pom1-om2*pom2
6246 eom2= 2*akth*deltat2+pom1-om1*pom2
6249 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
6250 ghpbx(k,i)=ghpbx(k,i)-ggk
6251 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
6252 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
6253 ghpbx(k,j)=ghpbx(k,j)+ggk
6254 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
6255 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
6256 ghpbc(k,i)=ghpbc(k,i)-ggk
6257 ghpbc(k,j)=ghpbc(k,j)+ggk
6260 C Calculate the components of the gradient in DC and X
6264 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
6269 C--------------------------------------------------------------------------
6270 subroutine ebond(estr)
6272 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
6274 implicit real*8 (a-h,o-z)
6275 include 'DIMENSIONS'
6276 include 'COMMON.LOCAL'
6277 include 'COMMON.GEO'
6278 include 'COMMON.INTERACT'
6279 include 'COMMON.DERIV'
6280 include 'COMMON.VAR'
6281 include 'COMMON.CHAIN'
6282 include 'COMMON.IOUNITS'
6283 include 'COMMON.NAMES'
6284 include 'COMMON.FFIELD'
6285 include 'COMMON.CONTROL'
6286 include 'COMMON.SETUP'
6287 double precision u(3),ud(3)
6290 do i=ibondp_start,ibondp_end
6291 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
6292 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
6294 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
6295 c & *dc(j,i-1)/vbld(i)
6297 c if (energy_dec) write(iout,*)
6298 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
6300 C Checking if it involves dummy (NH3+ or COO-) group
6301 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
6302 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
6303 diff = vbld(i)-vbldpDUM
6304 if (energy_dec) write(iout,*) "dum_bond",i,diff
6306 C NO vbldp0 is the equlibrium lenght of spring for peptide group
6307 diff = vbld(i)-vbldp0
6309 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
6310 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
6313 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
6315 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
6319 estr=0.5d0*AKP*estr+estr1
6321 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
6323 do i=ibond_start,ibond_end
6325 if (iti.ne.10 .and. iti.ne.ntyp1) then
6328 diff=vbld(i+nres)-vbldsc0(1,iti)
6329 if (energy_dec) write (iout,*)
6330 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
6331 & AKSC(1,iti),AKSC(1,iti)*diff*diff
6332 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
6334 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
6338 diff=vbld(i+nres)-vbldsc0(j,iti)
6339 if (energy_dec) write (iout,*)
6340 & "estr sc",i,iti,vbld(i+nres),vbldsc0(j,iti),diff,
6341 & AKSC(j,iti),AKSC(j,iti)*diff*diff
6342 ud(j)=aksc(j,iti)*diff
6343 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
6357 uprod2=uprod2*u(k)*u(k)
6361 usumsqder=usumsqder+ud(j)*uprod2
6363 estr=estr+uprod/usum
6365 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
6373 C--------------------------------------------------------------------------
6374 subroutine ebend(etheta,ethetacnstr)
6376 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6377 C angles gamma and its derivatives in consecutive thetas and gammas.
6379 implicit real*8 (a-h,o-z)
6380 include 'DIMENSIONS'
6381 include 'COMMON.LOCAL'
6382 include 'COMMON.GEO'
6383 include 'COMMON.INTERACT'
6384 include 'COMMON.DERIV'
6385 include 'COMMON.VAR'
6386 include 'COMMON.CHAIN'
6387 include 'COMMON.IOUNITS'
6388 include 'COMMON.NAMES'
6389 include 'COMMON.FFIELD'
6390 include 'COMMON.CONTROL'
6391 include 'COMMON.TORCNSTR'
6392 common /calcthet/ term1,term2,termm,diffak,ratak,
6393 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6394 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6395 double precision y(2),z(2)
6397 c time11=dexp(-2*time)
6400 write (*,'(a,i2)') 'EBEND ICG=',icg
6401 do i=ithet_start,ithet_end
6403 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6404 & .or.itype(i).eq.ntyp1) cycle
6405 C Zero the energy function and its derivative at 0 or pi.
6406 call splinthet(theta(i),0.5d0*delta,ss,ssd)
6408 ichir1=isign(1,itype(i-2))
6409 ichir2=isign(1,itype(i))
6410 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
6411 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
6412 if (itype(i-1).eq.10) then
6413 itype1=isign(10,itype(i-2))
6414 ichir11=isign(1,itype(i-2))
6415 ichir12=isign(1,itype(i-2))
6416 itype2=isign(10,itype(i))
6417 ichir21=isign(1,itype(i))
6418 ichir22=isign(1,itype(i))
6422 if (itype(i-3).ne.ntyp1) then
6425 if (phii.ne.phii) phii=150.0
6440 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6443 if (phii1.ne.phii1) phii1=150.0
6455 C Calculate the "mean" value of theta from the part of the distribution
6456 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
6457 C In following comments this theta will be referred to as t_c.
6458 thet_pred_mean=0.0d0
6460 athetk=athet(k,it,ichir1,ichir2)
6461 bthetk=bthet(k,it,ichir1,ichir2)
6463 athetk=athet(k,itype1,ichir11,ichir12)
6464 bthetk=bthet(k,itype2,ichir21,ichir22)
6466 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
6467 c write(iout,*) 'chuj tu', y(k),z(k)
6469 dthett=thet_pred_mean*ssd
6470 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
6471 C Derivatives of the "mean" values in gamma1 and gamma2.
6472 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
6473 &+athet(2,it,ichir1,ichir2)*y(1))*ss
6474 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
6475 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
6477 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
6478 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
6479 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
6480 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
6482 if (theta(i).gt.pi-delta) then
6483 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
6485 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
6486 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6487 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
6489 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
6491 else if (theta(i).lt.delta) then
6492 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
6493 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6494 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
6496 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
6497 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
6500 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
6503 etheta=etheta+ethetai
6504 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
6505 & 'ebend',i,ethetai,theta(i),itype(i)
6506 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
6507 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
6508 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
6511 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6512 do i=ithetaconstr_start,ithetaconstr_end
6513 itheta=itheta_constr(i)
6514 thetiii=theta(itheta)
6515 difi=pinorm(thetiii-theta_constr0(i))
6516 if (difi.gt.theta_drange(i)) then
6517 difi=difi-theta_drange(i)
6518 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6519 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6520 & +for_thet_constr(i)*difi**3
6521 else if (difi.lt.-drange(i)) then
6523 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6524 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6525 & +for_thet_constr(i)*difi**3
6529 if (energy_dec) then
6530 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6531 & i,itheta,rad2deg*thetiii,
6532 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6533 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6534 & gloc(itheta+nphi-2,icg)
6538 C Ufff.... We've done all this!!!
6541 C---------------------------------------------------------------------------
6542 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
6544 implicit real*8 (a-h,o-z)
6545 include 'DIMENSIONS'
6546 include 'COMMON.LOCAL'
6547 include 'COMMON.IOUNITS'
6548 common /calcthet/ term1,term2,termm,diffak,ratak,
6549 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6550 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6551 C Calculate the contributions to both Gaussian lobes.
6552 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6553 C The "polynomial part" of the "standard deviation" of this part of
6554 C the distributioni.
6555 ccc write (iout,*) thetai,thet_pred_mean
6558 sig=sig*thet_pred_mean+polthet(j,it)
6560 C Derivative of the "interior part" of the "standard deviation of the"
6561 C gamma-dependent Gaussian lobe in t_c.
6562 sigtc=3*polthet(3,it)
6564 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6567 C Set the parameters of both Gaussian lobes of the distribution.
6568 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6569 fac=sig*sig+sigc0(it)
6572 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6573 sigsqtc=-4.0D0*sigcsq*sigtc
6574 c print *,i,sig,sigtc,sigsqtc
6575 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
6576 sigtc=-sigtc/(fac*fac)
6577 C Following variable is sigma(t_c)**(-2)
6578 sigcsq=sigcsq*sigcsq
6580 sig0inv=1.0D0/sig0i**2
6581 delthec=thetai-thet_pred_mean
6582 delthe0=thetai-theta0i
6583 term1=-0.5D0*sigcsq*delthec*delthec
6584 term2=-0.5D0*sig0inv*delthe0*delthe0
6585 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
6586 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6587 C NaNs in taking the logarithm. We extract the largest exponent which is added
6588 C to the energy (this being the log of the distribution) at the end of energy
6589 C term evaluation for this virtual-bond angle.
6590 if (term1.gt.term2) then
6592 term2=dexp(term2-termm)
6596 term1=dexp(term1-termm)
6599 C The ratio between the gamma-independent and gamma-dependent lobes of
6600 C the distribution is a Gaussian function of thet_pred_mean too.
6601 diffak=gthet(2,it)-thet_pred_mean
6602 ratak=diffak/gthet(3,it)**2
6603 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6604 C Let's differentiate it in thet_pred_mean NOW.
6606 C Now put together the distribution terms to make complete distribution.
6607 termexp=term1+ak*term2
6608 termpre=sigc+ak*sig0i
6609 C Contribution of the bending energy from this theta is just the -log of
6610 C the sum of the contributions from the two lobes and the pre-exponential
6611 C factor. Simple enough, isn't it?
6612 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6613 C write (iout,*) 'termexp',termexp,termm,termpre,i
6614 C NOW the derivatives!!!
6615 C 6/6/97 Take into account the deformation.
6616 E_theta=(delthec*sigcsq*term1
6617 & +ak*delthe0*sig0inv*term2)/termexp
6618 E_tc=((sigtc+aktc*sig0i)/termpre
6619 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
6620 & aktc*term2)/termexp)
6623 c-----------------------------------------------------------------------------
6624 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
6625 implicit real*8 (a-h,o-z)
6626 include 'DIMENSIONS'
6627 include 'COMMON.LOCAL'
6628 include 'COMMON.IOUNITS'
6629 common /calcthet/ term1,term2,termm,diffak,ratak,
6630 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6631 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6632 delthec=thetai-thet_pred_mean
6633 delthe0=thetai-theta0i
6634 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
6635 t3 = thetai-thet_pred_mean
6639 t14 = t12+t6*sigsqtc
6641 t21 = thetai-theta0i
6647 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
6648 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
6649 & *(-t12*t9-ak*sig0inv*t27)
6653 C--------------------------------------------------------------------------
6654 subroutine ebend(etheta,ethetacnstr)
6656 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6657 C angles gamma and its derivatives in consecutive thetas and gammas.
6658 C ab initio-derived potentials from
6659 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6661 implicit real*8 (a-h,o-z)
6662 include 'DIMENSIONS'
6663 include 'COMMON.LOCAL'
6664 include 'COMMON.GEO'
6665 include 'COMMON.INTERACT'
6666 include 'COMMON.DERIV'
6667 include 'COMMON.VAR'
6668 include 'COMMON.CHAIN'
6669 include 'COMMON.IOUNITS'
6670 include 'COMMON.NAMES'
6671 include 'COMMON.FFIELD'
6672 include 'COMMON.CONTROL'
6673 include 'COMMON.TORCNSTR'
6674 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
6675 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
6676 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
6677 & sinph1ph2(maxdouble,maxdouble)
6678 logical lprn /.false./, lprn1 /.false./
6680 do i=ithet_start,ithet_end
6682 c print *,i,itype(i-1),itype(i),itype(i-2)
6683 C if (itype(i-1).eq.ntyp1) cycle
6684 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6685 & .or.itype(i).eq.ntyp1) cycle
6686 C print *,i,theta(i)
6687 if (iabs(itype(i+1)).eq.20) iblock=2
6688 if (iabs(itype(i+1)).ne.20) iblock=1
6692 theti2=0.5d0*theta(i)
6693 ityp2=ithetyp((itype(i-1)))
6695 coskt(k)=dcos(k*theti2)
6696 sinkt(k)=dsin(k*theti2)
6700 if (itype(i-3).ne.ntyp1) then
6703 if (phii.ne.phii) phii=150.0
6707 ityp1=ithetyp((itype(i-2)))
6708 C propagation of chirality for glycine type
6710 cosph1(k)=dcos(k*phii)
6711 sinph1(k)=dsin(k*phii)
6716 ityp1=ithetyp((itype(i-2)))
6724 ityp1=ithetyp((itype(i-2)))
6730 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6733 if (phii1.ne.phii1) phii1=150.0
6738 ityp3=ithetyp((itype(i)))
6740 cosph2(k)=dcos(k*phii1)
6741 sinph2(k)=dsin(k*phii1)
6745 ityp3=ithetyp((itype(i)))
6751 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
6754 ccl=cosph1(l)*cosph2(k-l)
6755 ssl=sinph1(l)*sinph2(k-l)
6756 scl=sinph1(l)*cosph2(k-l)
6757 csl=cosph1(l)*sinph2(k-l)
6758 cosph1ph2(l,k)=ccl-ssl
6759 cosph1ph2(k,l)=ccl+ssl
6760 sinph1ph2(l,k)=scl+csl
6761 sinph1ph2(k,l)=scl-csl
6765 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
6766 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6767 write (iout,*) "coskt and sinkt"
6769 write (iout,*) k,coskt(k),sinkt(k)
6773 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6774 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
6777 & write (iout,*) "k",k,"
6778 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
6779 & " ethetai",ethetai
6782 write (iout,*) "cosph and sinph"
6784 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6786 write (iout,*) "cosph1ph2 and sinph2ph2"
6789 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6790 & sinph1ph2(l,k),sinph1ph2(k,l)
6793 write(iout,*) "ethetai",ethetai
6798 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
6799 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
6800 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
6801 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6802 ethetai=ethetai+sinkt(m)*aux
6803 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6804 dephii=dephii+k*sinkt(m)*(
6805 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
6806 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6807 dephii1=dephii1+k*sinkt(m)*(
6808 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
6809 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6811 & write (iout,*) "m",m," k",k," bbthet",
6812 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
6813 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
6814 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
6815 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6816 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6819 C print *,"cosph1", (cosph1(k), k=1,nsingle)
6820 C print *,"cosph2", (cosph2(k), k=1,nsingle)
6821 C print *,"sinph1", (sinph1(k), k=1,nsingle)
6822 C print *,"sinph2", (sinph2(k), k=1,nsingle)
6824 & write(iout,*) "ethetai",ethetai
6825 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6829 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6830 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
6831 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6832 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6833 ethetai=ethetai+sinkt(m)*aux
6834 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6835 dephii=dephii+l*sinkt(m)*(
6836 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
6837 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6838 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6839 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6840 dephii1=dephii1+(k-l)*sinkt(m)*(
6841 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6842 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6843 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
6844 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6846 write (iout,*) "m",m," k",k," l",l," ffthet",
6847 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6848 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
6849 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6850 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
6851 & " ethetai",ethetai
6852 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6853 & cosph1ph2(k,l)*sinkt(m),
6854 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6863 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6864 & i,theta(i)*rad2deg,phii*rad2deg,
6865 & phii1*rad2deg,ethetai
6867 etheta=etheta+ethetai
6868 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6869 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6870 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
6874 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6875 do i=ithetaconstr_start,ithetaconstr_end
6876 itheta=itheta_constr(i)
6877 thetiii=theta(itheta)
6878 difi=pinorm(thetiii-theta_constr0(i))
6879 if (difi.gt.theta_drange(i)) then
6880 difi=difi-theta_drange(i)
6881 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6882 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6883 & +for_thet_constr(i)*difi**3
6884 else if (difi.lt.-drange(i)) then
6886 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6887 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6888 & +for_thet_constr(i)*difi**3
6892 if (energy_dec) then
6893 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6894 & i,itheta,rad2deg*thetiii,
6895 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6896 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6897 & gloc(itheta+nphi-2,icg)
6905 c-----------------------------------------------------------------------------
6906 subroutine esc(escloc)
6907 C Calculate the local energy of a side chain and its derivatives in the
6908 C corresponding virtual-bond valence angles THETA and the spherical angles
6910 implicit real*8 (a-h,o-z)
6911 include 'DIMENSIONS'
6912 include 'COMMON.GEO'
6913 include 'COMMON.LOCAL'
6914 include 'COMMON.VAR'
6915 include 'COMMON.INTERACT'
6916 include 'COMMON.DERIV'
6917 include 'COMMON.CHAIN'
6918 include 'COMMON.IOUNITS'
6919 include 'COMMON.NAMES'
6920 include 'COMMON.FFIELD'
6921 include 'COMMON.CONTROL'
6922 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6923 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6924 common /sccalc/ time11,time12,time112,theti,it,nlobit
6927 c write (iout,'(a)') 'ESC'
6928 do i=loc_start,loc_end
6930 if (it.eq.ntyp1) cycle
6931 if (it.eq.10) goto 1
6932 nlobit=nlob(iabs(it))
6933 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6934 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6935 theti=theta(i+1)-pipol
6940 if (x(2).gt.pi-delta) then
6944 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6946 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6947 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6949 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6950 & ddersc0(1),dersc(1))
6951 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6952 & ddersc0(3),dersc(3))
6954 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6956 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6957 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6958 & dersc0(2),esclocbi,dersc02)
6959 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6961 call splinthet(x(2),0.5d0*delta,ss,ssd)
6966 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6968 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6969 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6971 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6973 c write (iout,*) escloci
6974 else if (x(2).lt.delta) then
6978 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6980 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6981 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6983 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6984 & ddersc0(1),dersc(1))
6985 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6986 & ddersc0(3),dersc(3))
6988 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6990 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6991 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6992 & dersc0(2),esclocbi,dersc02)
6993 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6998 call splinthet(x(2),0.5d0*delta,ss,ssd)
7000 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
7002 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
7003 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
7005 escloci=ss*escloci+(1.0d0-ss)*esclocbi
7006 c write (iout,*) escloci
7008 call enesc(x,escloci,dersc,ddummy,.false.)
7011 escloc=escloc+escloci
7012 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7013 & 'escloc',i,escloci
7014 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
7016 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
7018 gloc(ialph(i,1),icg)=wscloc*dersc(2)
7019 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
7024 C---------------------------------------------------------------------------
7025 subroutine enesc(x,escloci,dersc,ddersc,mixed)
7026 implicit real*8 (a-h,o-z)
7027 include 'DIMENSIONS'
7028 include 'COMMON.GEO'
7029 include 'COMMON.LOCAL'
7030 include 'COMMON.IOUNITS'
7031 common /sccalc/ time11,time12,time112,theti,it,nlobit
7032 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
7033 double precision contr(maxlob,-1:1)
7035 c write (iout,*) 'it=',it,' nlobit=',nlobit
7039 if (mixed) ddersc(j)=0.0d0
7043 C Because of periodicity of the dependence of the SC energy in omega we have
7044 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
7045 C To avoid underflows, first compute & store the exponents.
7053 z(k)=x(k)-censc(k,j,it)
7058 Axk=Axk+gaussc(l,k,j,it)*z(l)
7064 expfac=expfac+Ax(k,j,iii)*z(k)
7072 C As in the case of ebend, we want to avoid underflows in exponentiation and
7073 C subsequent NaNs and INFs in energy calculation.
7074 C Find the largest exponent
7078 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
7082 cd print *,'it=',it,' emin=',emin
7084 C Compute the contribution to SC energy and derivatives
7089 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
7090 if(adexp.ne.adexp) adexp=1.0
7093 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
7095 cd print *,'j=',j,' expfac=',expfac
7096 escloc_i=escloc_i+expfac
7098 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
7102 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
7103 & +gaussc(k,2,j,it))*expfac
7110 dersc(1)=dersc(1)/cos(theti)**2
7111 ddersc(1)=ddersc(1)/cos(theti)**2
7114 escloci=-(dlog(escloc_i)-emin)
7116 dersc(j)=dersc(j)/escloc_i
7120 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
7125 C------------------------------------------------------------------------------
7126 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
7127 implicit real*8 (a-h,o-z)
7128 include 'DIMENSIONS'
7129 include 'COMMON.GEO'
7130 include 'COMMON.LOCAL'
7131 include 'COMMON.IOUNITS'
7132 common /sccalc/ time11,time12,time112,theti,it,nlobit
7133 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
7134 double precision contr(maxlob)
7145 z(k)=x(k)-censc(k,j,it)
7151 Axk=Axk+gaussc(l,k,j,it)*z(l)
7157 expfac=expfac+Ax(k,j)*z(k)
7162 C As in the case of ebend, we want to avoid underflows in exponentiation and
7163 C subsequent NaNs and INFs in energy calculation.
7164 C Find the largest exponent
7167 if (emin.gt.contr(j)) emin=contr(j)
7171 C Compute the contribution to SC energy and derivatives
7175 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
7176 escloc_i=escloc_i+expfac
7178 dersc(k)=dersc(k)+Ax(k,j)*expfac
7180 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
7181 & +gaussc(1,2,j,it))*expfac
7185 dersc(1)=dersc(1)/cos(theti)**2
7186 dersc12=dersc12/cos(theti)**2
7187 escloci=-(dlog(escloc_i)-emin)
7189 dersc(j)=dersc(j)/escloc_i
7191 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
7195 c----------------------------------------------------------------------------------
7196 subroutine esc(escloc)
7197 C Calculate the local energy of a side chain and its derivatives in the
7198 C corresponding virtual-bond valence angles THETA and the spherical angles
7199 C ALPHA and OMEGA derived from AM1 all-atom calculations.
7200 C added by Urszula Kozlowska. 07/11/2007
7202 implicit real*8 (a-h,o-z)
7203 include 'DIMENSIONS'
7204 include 'COMMON.GEO'
7205 include 'COMMON.LOCAL'
7206 include 'COMMON.VAR'
7207 include 'COMMON.SCROT'
7208 include 'COMMON.INTERACT'
7209 include 'COMMON.DERIV'
7210 include 'COMMON.CHAIN'
7211 include 'COMMON.IOUNITS'
7212 include 'COMMON.NAMES'
7213 include 'COMMON.FFIELD'
7214 include 'COMMON.CONTROL'
7215 include 'COMMON.VECTORS'
7216 double precision x_prime(3),y_prime(3),z_prime(3)
7217 & , sumene,dsc_i,dp2_i,x(65),
7218 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
7219 & de_dxx,de_dyy,de_dzz,de_dt
7220 double precision s1_t,s1_6_t,s2_t,s2_6_t
7222 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
7223 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
7224 & dt_dCi(3),dt_dCi1(3)
7225 common /sccalc/ time11,time12,time112,theti,it,nlobit
7228 do i=loc_start,loc_end
7229 if (itype(i).eq.ntyp1) cycle
7230 costtab(i+1) =dcos(theta(i+1))
7231 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
7232 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
7233 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
7234 cosfac2=0.5d0/(1.0d0+costtab(i+1))
7235 cosfac=dsqrt(cosfac2)
7236 sinfac2=0.5d0/(1.0d0-costtab(i+1))
7237 sinfac=dsqrt(sinfac2)
7239 if (it.eq.10) goto 1
7241 C Compute the axes of tghe local cartesian coordinates system; store in
7242 c x_prime, y_prime and z_prime
7249 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
7250 C & dc_norm(3,i+nres)
7252 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
7253 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
7256 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
7259 c write (2,*) "x_prime",(x_prime(j),j=1,3)
7260 c write (2,*) "y_prime",(y_prime(j),j=1,3)
7261 c write (2,*) "z_prime",(z_prime(j),j=1,3)
7262 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
7263 c & " xy",scalar(x_prime(1),y_prime(1)),
7264 c & " xz",scalar(x_prime(1),z_prime(1)),
7265 c & " yy",scalar(y_prime(1),y_prime(1)),
7266 c & " yz",scalar(y_prime(1),z_prime(1)),
7267 c & " zz",scalar(z_prime(1),z_prime(1))
7269 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
7270 C to local coordinate system. Store in xx, yy, zz.
7276 xx = xx + x_prime(j)*dc_norm(j,i+nres)
7277 yy = yy + y_prime(j)*dc_norm(j,i+nres)
7278 zz = zz + z_prime(j)*dc_norm(j,i+nres)
7285 C Compute the energy of the ith side cbain
7287 c write (2,*) "xx",xx," yy",yy," zz",zz
7290 x(j) = sc_parmin(j,it)
7293 Cc diagnostics - remove later
7295 yy1 = dsin(alph(2))*dcos(omeg(2))
7296 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
7297 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
7298 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
7300 C," --- ", xx_w,yy_w,zz_w
7303 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7304 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7306 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7307 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7309 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7310 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7311 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7312 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7313 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7315 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7316 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7317 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7318 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7319 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7321 dsc_i = 0.743d0+x(61)
7323 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7324 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
7325 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7326 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
7327 s1=(1+x(63))/(0.1d0 + dscp1)
7328 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7329 s2=(1+x(65))/(0.1d0 + dscp2)
7330 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7331 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
7332 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
7333 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
7335 c & dscp1,dscp2,sumene
7336 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7337 escloc = escloc + sumene
7338 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
7343 C This section to check the numerical derivatives of the energy of ith side
7344 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
7345 C #define DEBUG in the code to turn it on.
7347 write (2,*) "sumene =",sumene
7351 write (2,*) xx,yy,zz
7352 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7353 de_dxx_num=(sumenep-sumene)/aincr
7355 write (2,*) "xx+ sumene from enesc=",sumenep
7358 write (2,*) xx,yy,zz
7359 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7360 de_dyy_num=(sumenep-sumene)/aincr
7362 write (2,*) "yy+ sumene from enesc=",sumenep
7365 write (2,*) xx,yy,zz
7366 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7367 de_dzz_num=(sumenep-sumene)/aincr
7369 write (2,*) "zz+ sumene from enesc=",sumenep
7370 costsave=cost2tab(i+1)
7371 sintsave=sint2tab(i+1)
7372 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
7373 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
7374 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7375 de_dt_num=(sumenep-sumene)/aincr
7376 write (2,*) " t+ sumene from enesc=",sumenep
7377 cost2tab(i+1)=costsave
7378 sint2tab(i+1)=sintsave
7379 C End of diagnostics section.
7382 C Compute the gradient of esc
7384 c zz=zz*dsign(1.0,dfloat(itype(i)))
7385 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
7386 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
7387 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
7388 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
7389 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
7390 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
7391 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
7392 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
7393 pom1=(sumene3*sint2tab(i+1)+sumene1)
7394 & *(pom_s1/dscp1+pom_s16*dscp1**4)
7395 pom2=(sumene4*cost2tab(i+1)+sumene2)
7396 & *(pom_s2/dscp2+pom_s26*dscp2**4)
7397 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
7398 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
7399 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
7401 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
7402 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
7403 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
7405 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
7406 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
7407 & +(pom1+pom2)*pom_dx
7409 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
7412 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
7413 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
7414 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
7416 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
7417 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
7418 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
7419 & +x(59)*zz**2 +x(60)*xx*zz
7420 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
7421 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
7422 & +(pom1-pom2)*pom_dy
7424 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
7427 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
7428 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
7429 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
7430 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
7431 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
7432 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
7433 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
7434 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
7436 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
7439 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
7440 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
7441 & +pom1*pom_dt1+pom2*pom_dt2
7443 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
7448 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
7449 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
7450 cosfac2xx=cosfac2*xx
7451 sinfac2yy=sinfac2*yy
7453 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
7455 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
7457 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
7458 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
7459 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
7460 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
7461 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
7462 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
7463 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
7464 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
7465 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
7466 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
7470 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
7471 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
7472 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
7473 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
7476 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
7477 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
7478 dZZ_XYZ(k)=vbld_inv(i+nres)*
7479 & (z_prime(k)-zz*dC_norm(k,i+nres))
7481 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
7482 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
7486 dXX_Ctab(k,i)=dXX_Ci(k)
7487 dXX_C1tab(k,i)=dXX_Ci1(k)
7488 dYY_Ctab(k,i)=dYY_Ci(k)
7489 dYY_C1tab(k,i)=dYY_Ci1(k)
7490 dZZ_Ctab(k,i)=dZZ_Ci(k)
7491 dZZ_C1tab(k,i)=dZZ_Ci1(k)
7492 dXX_XYZtab(k,i)=dXX_XYZ(k)
7493 dYY_XYZtab(k,i)=dYY_XYZ(k)
7494 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
7498 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
7499 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
7500 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
7501 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
7502 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
7504 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
7505 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
7506 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
7507 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
7508 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
7509 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
7510 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
7511 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
7513 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
7514 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
7516 C to check gradient call subroutine check_grad
7522 c------------------------------------------------------------------------------
7523 double precision function enesc(x,xx,yy,zz,cost2,sint2)
7525 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
7526 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
7527 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7528 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7530 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7531 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7533 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7534 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7535 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7536 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7537 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7539 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7540 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7541 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7542 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7543 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7545 dsc_i = 0.743d0+x(61)
7547 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7548 & *(xx*cost2+yy*sint2))
7549 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7550 & *(xx*cost2-yy*sint2))
7551 s1=(1+x(63))/(0.1d0 + dscp1)
7552 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7553 s2=(1+x(65))/(0.1d0 + dscp2)
7554 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7555 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
7556 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
7561 c------------------------------------------------------------------------------
7562 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
7564 C This procedure calculates two-body contact function g(rij) and its derivative:
7567 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
7570 C where x=(rij-r0ij)/delta
7572 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
7575 double precision rij,r0ij,eps0ij,fcont,fprimcont
7576 double precision x,x2,x4,delta
7580 if (x.lt.-1.0D0) then
7583 else if (x.le.1.0D0) then
7586 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
7587 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7594 c------------------------------------------------------------------------------
7595 subroutine splinthet(theti,delta,ss,ssder)
7596 implicit real*8 (a-h,o-z)
7597 include 'DIMENSIONS'
7598 include 'COMMON.VAR'
7599 include 'COMMON.GEO'
7602 if (theti.gt.pipol) then
7603 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7605 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7610 c------------------------------------------------------------------------------
7611 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7613 double precision x,x0,delta,f0,f1,fprim0,f,fprim
7614 double precision ksi,ksi2,ksi3,a1,a2,a3
7615 a1=fprim0*delta/(f1-f0)
7621 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7622 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7625 c------------------------------------------------------------------------------
7626 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7628 double precision x,x0,delta,f0x,f1x,fprim0x,fx
7629 double precision ksi,ksi2,ksi3,a1,a2,a3
7634 a2=3*(f1x-f0x)-2*fprim0x*delta
7635 a3=fprim0x*delta-2*(f1x-f0x)
7636 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7639 C-----------------------------------------------------------------------------
7641 C-----------------------------------------------------------------------------
7642 subroutine etor(etors,edihcnstr)
7643 implicit real*8 (a-h,o-z)
7644 include 'DIMENSIONS'
7645 include 'COMMON.VAR'
7646 include 'COMMON.GEO'
7647 include 'COMMON.LOCAL'
7648 include 'COMMON.TORSION'
7649 include 'COMMON.INTERACT'
7650 include 'COMMON.DERIV'
7651 include 'COMMON.CHAIN'
7652 include 'COMMON.NAMES'
7653 include 'COMMON.IOUNITS'
7654 include 'COMMON.FFIELD'
7655 include 'COMMON.TORCNSTR'
7656 include 'COMMON.CONTROL'
7658 C Set lprn=.true. for debugging
7662 do i=iphi_start,iphi_end
7664 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7665 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7666 itori=itortyp(itype(i-2))
7667 itori1=itortyp(itype(i-1))
7670 C Proline-Proline pair is a special case...
7671 if (itori.eq.3 .and. itori1.eq.3) then
7672 if (phii.gt.-dwapi3) then
7674 fac=1.0D0/(1.0D0-cosphi)
7675 etorsi=v1(1,3,3)*fac
7676 etorsi=etorsi+etorsi
7677 etors=etors+etorsi-v1(1,3,3)
7678 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
7679 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7682 v1ij=v1(j+1,itori,itori1)
7683 v2ij=v2(j+1,itori,itori1)
7686 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7687 if (energy_dec) etors_ii=etors_ii+
7688 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7689 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7693 v1ij=v1(j,itori,itori1)
7694 v2ij=v2(j,itori,itori1)
7697 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7698 if (energy_dec) etors_ii=etors_ii+
7699 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7700 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7703 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7706 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7707 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7708 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7709 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7710 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7712 ! 6/20/98 - dihedral angle constraints
7715 itori=idih_constr(i)
7718 if (difi.gt.drange(i)) then
7720 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7721 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7722 else if (difi.lt.-drange(i)) then
7724 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
7725 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7727 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
7728 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7730 ! write (iout,*) 'edihcnstr',edihcnstr
7733 c------------------------------------------------------------------------------
7734 subroutine etor_d(etors_d)
7738 c----------------------------------------------------------------------------
7740 subroutine etor(etors,edihcnstr)
7741 implicit real*8 (a-h,o-z)
7742 include 'DIMENSIONS'
7743 include 'COMMON.VAR'
7744 include 'COMMON.GEO'
7745 include 'COMMON.LOCAL'
7746 include 'COMMON.TORSION'
7747 include 'COMMON.INTERACT'
7748 include 'COMMON.DERIV'
7749 include 'COMMON.CHAIN'
7750 include 'COMMON.NAMES'
7751 include 'COMMON.IOUNITS'
7752 include 'COMMON.FFIELD'
7753 include 'COMMON.TORCNSTR'
7754 include 'COMMON.CONTROL'
7756 C Set lprn=.true. for debugging
7760 do i=iphi_start,iphi_end
7761 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7762 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7763 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7764 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7765 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7766 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7767 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7768 C For introducing the NH3+ and COO- group please check the etor_d for reference
7771 if (iabs(itype(i)).eq.20) then
7776 itori=itortyp(itype(i-2))
7777 itori1=itortyp(itype(i-1))
7780 C Regular cosine and sine terms
7781 do j=1,nterm(itori,itori1,iblock)
7782 v1ij=v1(j,itori,itori1,iblock)
7783 v2ij=v2(j,itori,itori1,iblock)
7786 etors=etors+v1ij*cosphi+v2ij*sinphi
7787 if (energy_dec) etors_ii=etors_ii+
7788 & v1ij*cosphi+v2ij*sinphi
7789 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7793 C E = SUM ----------------------------------- - v1
7794 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7796 cosphi=dcos(0.5d0*phii)
7797 sinphi=dsin(0.5d0*phii)
7798 do j=1,nlor(itori,itori1,iblock)
7799 vl1ij=vlor1(j,itori,itori1)
7800 vl2ij=vlor2(j,itori,itori1)
7801 vl3ij=vlor3(j,itori,itori1)
7802 pom=vl2ij*cosphi+vl3ij*sinphi
7803 pom1=1.0d0/(pom*pom+1.0d0)
7804 etors=etors+vl1ij*pom1
7805 if (energy_dec) etors_ii=etors_ii+
7808 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7810 C Subtract the constant term
7811 etors=etors-v0(itori,itori1,iblock)
7812 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7813 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
7815 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7816 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7817 & (v1(j,itori,itori1,iblock),j=1,6),
7818 & (v2(j,itori,itori1,iblock),j=1,6)
7819 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7820 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7822 ! 6/20/98 - dihedral angle constraints
7824 c do i=1,ndih_constr
7825 do i=idihconstr_start,idihconstr_end
7826 itori=idih_constr(i)
7828 difi=pinorm(phii-phi0(i))
7829 if (difi.gt.drange(i)) then
7831 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7832 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7833 else if (difi.lt.-drange(i)) then
7835 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7836 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7840 if (energy_dec) then
7841 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
7842 & i,itori,rad2deg*phii,
7843 & rad2deg*phi0(i), rad2deg*drange(i),
7844 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
7847 cd write (iout,*) 'edihcnstr',edihcnstr
7850 c----------------------------------------------------------------------------
7851 subroutine etor_d(etors_d)
7852 C 6/23/01 Compute double torsional energy
7853 implicit real*8 (a-h,o-z)
7854 include 'DIMENSIONS'
7855 include 'COMMON.VAR'
7856 include 'COMMON.GEO'
7857 include 'COMMON.LOCAL'
7858 include 'COMMON.TORSION'
7859 include 'COMMON.INTERACT'
7860 include 'COMMON.DERIV'
7861 include 'COMMON.CHAIN'
7862 include 'COMMON.NAMES'
7863 include 'COMMON.IOUNITS'
7864 include 'COMMON.FFIELD'
7865 include 'COMMON.TORCNSTR'
7867 C Set lprn=.true. for debugging
7871 c write(iout,*) "a tu??"
7872 do i=iphid_start,iphid_end
7873 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7874 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7875 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7876 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7877 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7878 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7879 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7880 & (itype(i+1).eq.ntyp1)) cycle
7881 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7882 itori=itortyp(itype(i-2))
7883 itori1=itortyp(itype(i-1))
7884 itori2=itortyp(itype(i))
7890 if (iabs(itype(i+1)).eq.20) iblock=2
7891 C Iblock=2 Proline type
7892 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7893 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7894 C if (itype(i+1).eq.ntyp1) iblock=3
7895 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7896 C IS or IS NOT need for this
7897 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7898 C is (itype(i-3).eq.ntyp1) ntblock=2
7899 C ntblock is N-terminal blocking group
7901 C Regular cosine and sine terms
7902 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7903 C Example of changes for NH3+ blocking group
7904 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7905 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7906 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7907 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7908 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7909 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7910 cosphi1=dcos(j*phii)
7911 sinphi1=dsin(j*phii)
7912 cosphi2=dcos(j*phii1)
7913 sinphi2=dsin(j*phii1)
7914 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7915 & v2cij*cosphi2+v2sij*sinphi2
7916 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7917 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7919 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7921 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7922 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7923 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7924 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7925 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7926 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7927 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7928 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7929 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7930 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7931 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7932 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7933 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7934 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7937 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7938 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7943 C----------------------------------------------------------------------------------
7944 C The rigorous attempt to derive energy function
7945 subroutine etor_kcc(etors,edihcnstr)
7946 implicit real*8 (a-h,o-z)
7947 include 'DIMENSIONS'
7948 include 'COMMON.VAR'
7949 include 'COMMON.GEO'
7950 include 'COMMON.LOCAL'
7951 include 'COMMON.TORSION'
7952 include 'COMMON.INTERACT'
7953 include 'COMMON.DERIV'
7954 include 'COMMON.CHAIN'
7955 include 'COMMON.NAMES'
7956 include 'COMMON.IOUNITS'
7957 include 'COMMON.FFIELD'
7958 include 'COMMON.TORCNSTR'
7959 include 'COMMON.CONTROL'
7961 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
7962 C Set lprn=.true. for debugging
7965 C print *,"wchodze kcc"
7966 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
7967 if (tor_mode.ne.2) then
7970 do i=iphi_start,iphi_end
7971 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7972 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7973 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7974 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7975 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7976 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7977 itori=itortyp_kcc(itype(i-2))
7978 itori1=itortyp_kcc(itype(i-1))
7983 sumnonchebyshev=0.0d0
7985 C to avoid multiple devision by 2
7986 c theti22=0.5d0*theta(i)
7987 C theta 12 is the theta_1 /2
7988 C theta 22 is theta_2 /2
7989 c theti12=0.5d0*theta(i-1)
7990 C and appropriate sinus function
7991 sinthet1=dsin(theta(i-1))
7992 sinthet2=dsin(theta(i))
7993 costhet1=dcos(theta(i-1))
7994 costhet2=dcos(theta(i))
7995 c Cosines of halves thetas
7996 costheti12=0.5d0*(1.0d0+costhet1)
7997 costheti22=0.5d0*(1.0d0+costhet2)
7998 C to speed up lets store its mutliplication
7999 sint1t2=sinthet2*sinthet1
8001 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
8002 C +d_n*sin(n*gamma)) *
8003 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
8004 C we have two sum 1) Non-Chebyshev which is with n and gamma
8006 do j=1,nterm_kcc(itori,itori1)
8008 nval=nterm_kcc_Tb(itori,itori1)
8009 v1ij=v1_kcc(j,itori,itori1)
8010 v2ij=v2_kcc(j,itori,itori1)
8011 c write (iout,*) "i",i," j",j," v1",v1ij," v2",v2ij
8012 C v1ij is c_n and d_n in euation above
8016 sint1t2n=sint1t2n*sint1t2
8017 sumth1tyb1=tschebyshev(1,nval,v11_chyb(1,j,itori,itori1),
8019 gradth1tyb1=-0.5d0*sinthet1*gradtschebyshev(0,nval-1,
8020 & v11_chyb(1,j,itori,itori1),costheti12)
8021 c write (iout,*) "v11",(v11_chyb(k,j,itori,itori1),k=1,nval),
8022 c & " sumth1tyb1",sumth1tyb1," gradth1tyb1",gradth1tyb1
8023 sumth2tyb1=tschebyshev(1,nval,v21_chyb(1,j,itori,itori1),
8025 gradth2tyb1=-0.5d0*sinthet2*gradtschebyshev(0,nval-1,
8026 & v21_chyb(1,j,itori,itori1),costheti22)
8027 c write (iout,*) "v21",(v21_chyb(k,j,itori,itori1),k=1,nval),
8028 c & " sumth2tyb1",sumth2tyb1," gradth2tyb1",gradth2tyb1
8029 sumth1tyb2=tschebyshev(1,nval,v12_chyb(1,j,itori,itori1),
8031 gradth1tyb2=-0.5d0*sinthet1*gradtschebyshev(0,nval-1,
8032 & v12_chyb(1,j,itori,itori1),costheti12)
8033 c write (iout,*) "v12",(v12_chyb(k,j,itori,itori1),k=1,nval),
8034 c & " sumth1tyb2",sumth1tyb2," gradth1tyb2",gradth1tyb2
8035 sumth2tyb2=tschebyshev(1,nval,v22_chyb(1,j,itori,itori1),
8037 gradth2tyb2=-0.5d0*sinthet2*gradtschebyshev(0,nval-1,
8038 & v22_chyb(1,j,itori,itori1),costheti22)
8039 c write (iout,*) "v22",(v22_chyb(k,j,itori,itori1),k=1,nval),
8040 c & " sumth2tyb2",sumth2tyb2," gradth2tyb2",gradth2tyb2
8041 C etors=etors+sint1t2n*(v1ij*cosphi+v2ij*sinphi)
8042 C if (energy_dec) etors_ii=etors_ii+
8043 C & v1ij*cosphi+v2ij*sinphi
8044 C glocig is the gradient local i site in gamma
8045 actval1=v1ij*cosphi*(1.0d0+sumth1tyb1+sumth2tyb1)
8046 actval2=v2ij*sinphi*(1.0d0+sumth1tyb2+sumth2tyb2)
8047 etori=etori+sint1t2n*(actval1+actval2)
8049 & j*sint1t2n*(v2ij*cosphi*(1.0d0+sumth1tyb2+sumth2tyb2)
8050 & -v1ij*sinphi*(1.0d0+sumth1tyb1+sumth2tyb1))
8051 C now gradient over theta_1
8053 & j*sint1t2n1*costhet1*sinthet2*(actval1+actval2)+
8054 & sint1t2n*(v1ij*cosphi*gradth1tyb1+v2ij*sinphi*gradth1tyb2)
8056 & j*sint1t2n1*sinthet1*costhet2*(actval1+actval2)+
8057 & sint1t2n*(v1ij*cosphi*gradth2tyb1+v2ij*sinphi*gradth2tyb2)
8059 C now the Czebyshev polinominal sum
8060 c do k=1,nterm_kcc_Tb(itori,itori1)
8061 c thybt1(k)=v1_chyb(k,j,itori,itori1)
8062 c thybt2(k)=v2_chyb(k,j,itori,itori1)
8066 C print *, sumth1thyb, gradthybt1, sumth2thyb, gradthybt2,
8068 C & (0,nterm_kcc_Tb(itori,itori1)-1,thybt2(1),
8069 C & dcos(theti22)**2),
8072 C now overal sumation
8073 C print *,"sumnon", sumnonchebyshev,sumth1thyb+sumth2thyb
8076 C derivative over gamma
8077 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
8078 C derivative over theta1
8079 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
8080 C now derivative over theta2
8081 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
8083 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
8084 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
8086 C gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
8087 ! 6/20/98 - dihedral angle constraints
8088 if (tor_mode.ne.2) then
8090 c do i=1,ndih_constr
8091 do i=idihconstr_start,idihconstr_end
8092 itori=idih_constr(i)
8094 difi=pinorm(phii-phi0(i))
8095 if (difi.gt.drange(i)) then
8097 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
8098 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
8099 else if (difi.lt.-drange(i)) then
8101 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
8102 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
8111 C The rigorous attempt to derive energy function
8112 subroutine ebend_kcc(etheta,ethetacnstr)
8114 implicit real*8 (a-h,o-z)
8115 include 'DIMENSIONS'
8116 include 'COMMON.VAR'
8117 include 'COMMON.GEO'
8118 include 'COMMON.LOCAL'
8119 include 'COMMON.TORSION'
8120 include 'COMMON.INTERACT'
8121 include 'COMMON.DERIV'
8122 include 'COMMON.CHAIN'
8123 include 'COMMON.NAMES'
8124 include 'COMMON.IOUNITS'
8125 include 'COMMON.FFIELD'
8126 include 'COMMON.TORCNSTR'
8127 include 'COMMON.CONTROL'
8129 double precision thybt1(maxtermkcc)
8130 C Set lprn=.true. for debugging
8133 C print *,"wchodze kcc"
8134 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
8135 if (tor_mode.ne.2) etheta=0.0D0
8136 do i=ithet_start,ithet_end
8137 c print *,i,itype(i-1),itype(i),itype(i-2)
8138 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
8139 & .or.itype(i).eq.ntyp1) cycle
8140 iti=itortyp_kcc(itype(i-1))
8141 sinthet=dsin(theta(i)/2.0d0)
8142 costhet=dcos(theta(i)/2.0d0)
8143 do j=1,nbend_kcc_Tb(iti)
8144 thybt1(j)=v1bend_chyb(j,iti)
8146 sumth1thyb=tschebyshev
8147 & (1,nbend_kcc_Tb(iti),thybt1(1),costhet)
8148 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
8150 ihelp=nbend_kcc_Tb(iti)-1
8151 gradthybt1=gradtschebyshev
8152 & (0,ihelp,thybt1(1),costhet)
8153 etheta=etheta+sumth1thyb
8154 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
8155 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*
8156 & gradthybt1*sinthet*(-0.5d0)
8158 if (tor_mode.ne.2) then
8160 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
8161 do i=ithetaconstr_start,ithetaconstr_end
8162 itheta=itheta_constr(i)
8163 thetiii=theta(itheta)
8164 difi=pinorm(thetiii-theta_constr0(i))
8165 if (difi.gt.theta_drange(i)) then
8166 difi=difi-theta_drange(i)
8167 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
8168 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
8169 & +for_thet_constr(i)*difi**3
8170 else if (difi.lt.-drange(i)) then
8172 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
8173 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
8174 & +for_thet_constr(i)*difi**3
8178 if (energy_dec) then
8179 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
8180 & i,itheta,rad2deg*thetiii,
8181 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
8182 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
8183 & gloc(itheta+nphi-2,icg)
8189 c------------------------------------------------------------------------------
8190 subroutine eback_sc_corr(esccor)
8191 c 7/21/2007 Correlations between the backbone-local and side-chain-local
8192 c conformational states; temporarily implemented as differences
8193 c between UNRES torsional potentials (dependent on three types of
8194 c residues) and the torsional potentials dependent on all 20 types
8195 c of residues computed from AM1 energy surfaces of terminally-blocked
8196 c amino-acid residues.
8197 implicit real*8 (a-h,o-z)
8198 include 'DIMENSIONS'
8199 include 'COMMON.VAR'
8200 include 'COMMON.GEO'
8201 include 'COMMON.LOCAL'
8202 include 'COMMON.TORSION'
8203 include 'COMMON.SCCOR'
8204 include 'COMMON.INTERACT'
8205 include 'COMMON.DERIV'
8206 include 'COMMON.CHAIN'
8207 include 'COMMON.NAMES'
8208 include 'COMMON.IOUNITS'
8209 include 'COMMON.FFIELD'
8210 include 'COMMON.CONTROL'
8212 C Set lprn=.true. for debugging
8215 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
8217 do i=itau_start,itau_end
8218 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
8220 isccori=isccortyp(itype(i-2))
8221 isccori1=isccortyp(itype(i-1))
8222 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
8224 do intertyp=1,3 !intertyp
8225 cc Added 09 May 2012 (Adasko)
8226 cc Intertyp means interaction type of backbone mainchain correlation:
8227 c 1 = SC...Ca...Ca...Ca
8228 c 2 = Ca...Ca...Ca...SC
8229 c 3 = SC...Ca...Ca...SCi
8231 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
8232 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
8233 & (itype(i-1).eq.ntyp1)))
8234 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
8235 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
8236 & .or.(itype(i).eq.ntyp1)))
8237 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
8238 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
8239 & (itype(i-3).eq.ntyp1)))) cycle
8240 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
8241 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
8243 do j=1,nterm_sccor(isccori,isccori1)
8244 v1ij=v1sccor(j,intertyp,isccori,isccori1)
8245 v2ij=v2sccor(j,intertyp,isccori,isccori1)
8246 cosphi=dcos(j*tauangle(intertyp,i))
8247 sinphi=dsin(j*tauangle(intertyp,i))
8248 esccor=esccor+v1ij*cosphi+v2ij*sinphi
8249 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
8251 if (energy_dec) write(iout,'(a9,2i4,f8.3,3i4)') "esccor",i,j,
8254 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
8255 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
8257 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
8258 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
8259 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
8260 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
8261 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
8267 c----------------------------------------------------------------------------
8268 subroutine multibody(ecorr)
8269 C This subroutine calculates multi-body contributions to energy following
8270 C the idea of Skolnick et al. If side chains I and J make a contact and
8271 C at the same time side chains I+1 and J+1 make a contact, an extra
8272 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
8273 implicit real*8 (a-h,o-z)
8274 include 'DIMENSIONS'
8275 include 'COMMON.IOUNITS'
8276 include 'COMMON.DERIV'
8277 include 'COMMON.INTERACT'
8278 include 'COMMON.CONTACTS'
8279 double precision gx(3),gx1(3)
8282 C Set lprn=.true. for debugging
8286 write (iout,'(a)') 'Contact function values:'
8288 write (iout,'(i2,20(1x,i2,f10.5))')
8289 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
8304 num_conti=num_cont(i)
8305 num_conti1=num_cont(i1)
8310 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
8311 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8312 cd & ' ishift=',ishift
8313 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
8314 C The system gains extra energy.
8315 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
8316 endif ! j1==j+-ishift
8325 c------------------------------------------------------------------------------
8326 double precision function esccorr(i,j,k,l,jj,kk)
8327 implicit real*8 (a-h,o-z)
8328 include 'DIMENSIONS'
8329 include 'COMMON.IOUNITS'
8330 include 'COMMON.DERIV'
8331 include 'COMMON.INTERACT'
8332 include 'COMMON.CONTACTS'
8333 include 'COMMON.SHIELD'
8334 double precision gx(3),gx1(3)
8339 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
8340 C Calculate the multi-body contribution to energy.
8341 C Calculate multi-body contributions to the gradient.
8342 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
8343 cd & k,l,(gacont(m,kk,k),m=1,3)
8345 gx(m) =ekl*gacont(m,jj,i)
8346 gx1(m)=eij*gacont(m,kk,k)
8347 gradxorr(m,i)=gradxorr(m,i)-gx(m)
8348 gradxorr(m,j)=gradxorr(m,j)+gx(m)
8349 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
8350 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
8354 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
8359 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
8365 c------------------------------------------------------------------------------
8366 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
8367 C This subroutine calculates multi-body contributions to hydrogen-bonding
8368 implicit real*8 (a-h,o-z)
8369 include 'DIMENSIONS'
8370 include 'COMMON.IOUNITS'
8373 parameter (max_cont=maxconts)
8374 parameter (max_dim=26)
8375 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8376 double precision zapas(max_dim,maxconts,max_fg_procs),
8377 & zapas_recv(max_dim,maxconts,max_fg_procs)
8378 common /przechowalnia/ zapas
8379 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8380 & status_array(MPI_STATUS_SIZE,maxconts*2)
8382 include 'COMMON.SETUP'
8383 include 'COMMON.FFIELD'
8384 include 'COMMON.DERIV'
8385 include 'COMMON.INTERACT'
8386 include 'COMMON.CONTACTS'
8387 include 'COMMON.CONTROL'
8388 include 'COMMON.LOCAL'
8389 double precision gx(3),gx1(3),time00
8392 C Set lprn=.true. for debugging
8397 if (nfgtasks.le.1) goto 30
8399 write (iout,'(a)') 'Contact function values before RECEIVE:'
8401 write (iout,'(2i3,50(1x,i2,f5.2))')
8402 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8403 & j=1,num_cont_hb(i))
8407 do i=1,ntask_cont_from
8410 do i=1,ntask_cont_to
8413 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8415 C Make the list of contacts to send to send to other procesors
8416 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
8418 do i=iturn3_start,iturn3_end
8419 c write (iout,*) "make contact list turn3",i," num_cont",
8421 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
8423 do i=iturn4_start,iturn4_end
8424 c write (iout,*) "make contact list turn4",i," num_cont",
8426 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
8430 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8432 do j=1,num_cont_hb(i)
8435 iproc=iint_sent_local(k,jjc,ii)
8436 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8437 if (iproc.gt.0) then
8438 ncont_sent(iproc)=ncont_sent(iproc)+1
8439 nn=ncont_sent(iproc)
8441 zapas(2,nn,iproc)=jjc
8442 zapas(3,nn,iproc)=facont_hb(j,i)
8443 zapas(4,nn,iproc)=ees0p(j,i)
8444 zapas(5,nn,iproc)=ees0m(j,i)
8445 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
8446 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
8447 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
8448 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
8449 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
8450 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
8451 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
8452 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
8453 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
8454 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
8455 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
8456 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
8457 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
8458 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
8459 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
8460 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
8461 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
8462 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
8463 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
8464 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
8465 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
8472 & "Numbers of contacts to be sent to other processors",
8473 & (ncont_sent(i),i=1,ntask_cont_to)
8474 write (iout,*) "Contacts sent"
8475 do ii=1,ntask_cont_to
8477 iproc=itask_cont_to(ii)
8478 write (iout,*) nn," contacts to processor",iproc,
8479 & " of CONT_TO_COMM group"
8481 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8489 CorrelID1=nfgtasks+fg_rank+1
8491 C Receive the numbers of needed contacts from other processors
8492 do ii=1,ntask_cont_from
8493 iproc=itask_cont_from(ii)
8495 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8496 & FG_COMM,req(ireq),IERR)
8498 c write (iout,*) "IRECV ended"
8500 C Send the number of contacts needed by other processors
8501 do ii=1,ntask_cont_to
8502 iproc=itask_cont_to(ii)
8504 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8505 & FG_COMM,req(ireq),IERR)
8507 c write (iout,*) "ISEND ended"
8508 c write (iout,*) "number of requests (nn)",ireq
8511 & call MPI_Waitall(ireq,req,status_array,ierr)
8513 c & "Numbers of contacts to be received from other processors",
8514 c & (ncont_recv(i),i=1,ntask_cont_from)
8518 do ii=1,ntask_cont_from
8519 iproc=itask_cont_from(ii)
8521 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8522 c & " of CONT_TO_COMM group"
8526 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8527 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8528 c write (iout,*) "ireq,req",ireq,req(ireq)
8531 C Send the contacts to processors that need them
8532 do ii=1,ntask_cont_to
8533 iproc=itask_cont_to(ii)
8535 c write (iout,*) nn," contacts to processor",iproc,
8536 c & " of CONT_TO_COMM group"
8539 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8540 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8541 c write (iout,*) "ireq,req",ireq,req(ireq)
8543 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8547 c write (iout,*) "number of requests (contacts)",ireq
8548 c write (iout,*) "req",(req(i),i=1,4)
8551 & call MPI_Waitall(ireq,req,status_array,ierr)
8552 do iii=1,ntask_cont_from
8553 iproc=itask_cont_from(iii)
8556 write (iout,*) "Received",nn," contacts from processor",iproc,
8557 & " of CONT_FROM_COMM group"
8560 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8565 ii=zapas_recv(1,i,iii)
8566 c Flag the received contacts to prevent double-counting
8567 jj=-zapas_recv(2,i,iii)
8568 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8570 nnn=num_cont_hb(ii)+1
8573 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8574 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8575 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8576 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8577 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8578 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8579 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8580 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8581 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8582 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8583 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8584 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8585 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8586 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8587 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8588 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8589 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8590 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8591 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8592 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8593 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8594 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8595 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8596 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8601 write (iout,'(a)') 'Contact function values after receive:'
8603 write (iout,'(2i3,50(1x,i3,f5.2))')
8604 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8605 & j=1,num_cont_hb(i))
8612 write (iout,'(a)') 'Contact function values:'
8614 write (iout,'(2i3,50(1x,i3,f5.2))')
8615 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8616 & j=1,num_cont_hb(i))
8620 C Remove the loop below after debugging !!!
8627 C Calculate the local-electrostatic correlation terms
8628 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8630 num_conti=num_cont_hb(i)
8631 num_conti1=num_cont_hb(i+1)
8638 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8639 c & ' jj=',jj,' kk=',kk
8640 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8641 & .or. j.lt.0 .and. j1.gt.0) .and.
8642 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8643 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8644 C The system gains extra energy.
8645 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8646 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
8647 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
8649 else if (j1.eq.j) then
8650 C Contacts I-J and I-(J+1) occur simultaneously.
8651 C The system loses extra energy.
8652 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8657 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8658 c & ' jj=',jj,' kk=',kk
8660 C Contacts I-J and (I+1)-J occur simultaneously.
8661 C The system loses extra energy.
8662 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8669 c------------------------------------------------------------------------------
8670 subroutine add_hb_contact(ii,jj,itask)
8671 implicit real*8 (a-h,o-z)
8672 include "DIMENSIONS"
8673 include "COMMON.IOUNITS"
8676 parameter (max_cont=maxconts)
8677 parameter (max_dim=26)
8678 include "COMMON.CONTACTS"
8679 double precision zapas(max_dim,maxconts,max_fg_procs),
8680 & zapas_recv(max_dim,maxconts,max_fg_procs)
8681 common /przechowalnia/ zapas
8682 integer i,j,ii,jj,iproc,itask(4),nn
8683 c write (iout,*) "itask",itask
8686 if (iproc.gt.0) then
8687 do j=1,num_cont_hb(ii)
8689 c write (iout,*) "i",ii," j",jj," jjc",jjc
8691 ncont_sent(iproc)=ncont_sent(iproc)+1
8692 nn=ncont_sent(iproc)
8693 zapas(1,nn,iproc)=ii
8694 zapas(2,nn,iproc)=jjc
8695 zapas(3,nn,iproc)=facont_hb(j,ii)
8696 zapas(4,nn,iproc)=ees0p(j,ii)
8697 zapas(5,nn,iproc)=ees0m(j,ii)
8698 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8699 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8700 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8701 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8702 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8703 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8704 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8705 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8706 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8707 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8708 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8709 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8710 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8711 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8712 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8713 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8714 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8715 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8716 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8717 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8718 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8726 c------------------------------------------------------------------------------
8727 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8729 C This subroutine calculates multi-body contributions to hydrogen-bonding
8730 implicit real*8 (a-h,o-z)
8731 include 'DIMENSIONS'
8732 include 'COMMON.IOUNITS'
8735 parameter (max_cont=maxconts)
8736 parameter (max_dim=70)
8737 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8738 double precision zapas(max_dim,maxconts,max_fg_procs),
8739 & zapas_recv(max_dim,maxconts,max_fg_procs)
8740 common /przechowalnia/ zapas
8741 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8742 & status_array(MPI_STATUS_SIZE,maxconts*2)
8744 include 'COMMON.SETUP'
8745 include 'COMMON.FFIELD'
8746 include 'COMMON.DERIV'
8747 include 'COMMON.LOCAL'
8748 include 'COMMON.INTERACT'
8749 include 'COMMON.CONTACTS'
8750 include 'COMMON.CHAIN'
8751 include 'COMMON.CONTROL'
8752 include 'COMMON.SHIELD'
8753 double precision gx(3),gx1(3)
8754 integer num_cont_hb_old(maxres)
8756 double precision eello4,eello5,eelo6,eello_turn6
8757 external eello4,eello5,eello6,eello_turn6
8758 C Set lprn=.true. for debugging
8763 num_cont_hb_old(i)=num_cont_hb(i)
8767 if (nfgtasks.le.1) goto 30
8769 write (iout,'(a)') 'Contact function values before RECEIVE:'
8771 write (iout,'(2i3,50(1x,i2,f5.2))')
8772 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8773 & j=1,num_cont_hb(i))
8777 do i=1,ntask_cont_from
8780 do i=1,ntask_cont_to
8783 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8785 C Make the list of contacts to send to send to other procesors
8786 do i=iturn3_start,iturn3_end
8787 c write (iout,*) "make contact list turn3",i," num_cont",
8789 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8791 do i=iturn4_start,iturn4_end
8792 c write (iout,*) "make contact list turn4",i," num_cont",
8794 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8798 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8800 do j=1,num_cont_hb(i)
8803 iproc=iint_sent_local(k,jjc,ii)
8804 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8805 if (iproc.ne.0) then
8806 ncont_sent(iproc)=ncont_sent(iproc)+1
8807 nn=ncont_sent(iproc)
8809 zapas(2,nn,iproc)=jjc
8810 zapas(3,nn,iproc)=d_cont(j,i)
8814 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8819 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8827 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8838 & "Numbers of contacts to be sent to other processors",
8839 & (ncont_sent(i),i=1,ntask_cont_to)
8840 write (iout,*) "Contacts sent"
8841 do ii=1,ntask_cont_to
8843 iproc=itask_cont_to(ii)
8844 write (iout,*) nn," contacts to processor",iproc,
8845 & " of CONT_TO_COMM group"
8847 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8855 CorrelID1=nfgtasks+fg_rank+1
8857 C Receive the numbers of needed contacts from other processors
8858 do ii=1,ntask_cont_from
8859 iproc=itask_cont_from(ii)
8861 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8862 & FG_COMM,req(ireq),IERR)
8864 c write (iout,*) "IRECV ended"
8866 C Send the number of contacts needed by other processors
8867 do ii=1,ntask_cont_to
8868 iproc=itask_cont_to(ii)
8870 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8871 & FG_COMM,req(ireq),IERR)
8873 c write (iout,*) "ISEND ended"
8874 c write (iout,*) "number of requests (nn)",ireq
8877 & call MPI_Waitall(ireq,req,status_array,ierr)
8879 c & "Numbers of contacts to be received from other processors",
8880 c & (ncont_recv(i),i=1,ntask_cont_from)
8884 do ii=1,ntask_cont_from
8885 iproc=itask_cont_from(ii)
8887 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8888 c & " of CONT_TO_COMM group"
8892 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8893 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8894 c write (iout,*) "ireq,req",ireq,req(ireq)
8897 C Send the contacts to processors that need them
8898 do ii=1,ntask_cont_to
8899 iproc=itask_cont_to(ii)
8901 c write (iout,*) nn," contacts to processor",iproc,
8902 c & " of CONT_TO_COMM group"
8905 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8906 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8907 c write (iout,*) "ireq,req",ireq,req(ireq)
8909 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8913 c write (iout,*) "number of requests (contacts)",ireq
8914 c write (iout,*) "req",(req(i),i=1,4)
8917 & call MPI_Waitall(ireq,req,status_array,ierr)
8918 do iii=1,ntask_cont_from
8919 iproc=itask_cont_from(iii)
8922 write (iout,*) "Received",nn," contacts from processor",iproc,
8923 & " of CONT_FROM_COMM group"
8926 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8931 ii=zapas_recv(1,i,iii)
8932 c Flag the received contacts to prevent double-counting
8933 jj=-zapas_recv(2,i,iii)
8934 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8936 nnn=num_cont_hb(ii)+1
8939 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8943 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8948 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8956 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8965 write (iout,'(a)') 'Contact function values after receive:'
8967 write (iout,'(2i3,50(1x,i3,5f6.3))')
8968 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8969 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8976 write (iout,'(a)') 'Contact function values:'
8978 write (iout,'(2i3,50(1x,i2,5f6.3))')
8979 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8980 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8986 C Remove the loop below after debugging !!!
8993 C Calculate the dipole-dipole interaction energies
8994 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8995 do i=iatel_s,iatel_e+1
8996 num_conti=num_cont_hb(i)
9005 C Calculate the local-electrostatic correlation terms
9006 c write (iout,*) "gradcorr5 in eello5 before loop"
9008 c write (iout,'(i5,3f10.5)')
9009 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
9011 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
9012 c write (iout,*) "corr loop i",i
9014 num_conti=num_cont_hb(i)
9015 num_conti1=num_cont_hb(i+1)
9022 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
9023 c & ' jj=',jj,' kk=',kk
9024 c if (j1.eq.j+1 .or. j1.eq.j-1) then
9025 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
9026 & .or. j.lt.0 .and. j1.gt.0) .and.
9027 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
9028 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
9029 C The system gains extra energy.
9031 sqd1=dsqrt(d_cont(jj,i))
9032 sqd2=dsqrt(d_cont(kk,i1))
9033 sred_geom = sqd1*sqd2
9034 IF (sred_geom.lt.cutoff_corr) THEN
9035 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
9037 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
9038 cd & ' jj=',jj,' kk=',kk
9039 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
9040 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
9042 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
9043 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
9046 cd write (iout,*) 'sred_geom=',sred_geom,
9047 cd & ' ekont=',ekont,' fprim=',fprimcont,
9048 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
9049 cd write (iout,*) "g_contij",g_contij
9050 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
9051 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
9052 call calc_eello(i,jp,i+1,jp1,jj,kk)
9053 if (wcorr4.gt.0.0d0)
9054 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
9055 CC & *fac_shield(i)**2*fac_shield(j)**2
9056 if (energy_dec.and.wcorr4.gt.0.0d0)
9057 1 write (iout,'(a6,4i5,0pf7.3)')
9058 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
9059 c write (iout,*) "gradcorr5 before eello5"
9061 c write (iout,'(i5,3f10.5)')
9062 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
9064 if (wcorr5.gt.0.0d0)
9065 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
9066 c write (iout,*) "gradcorr5 after eello5"
9068 c write (iout,'(i5,3f10.5)')
9069 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
9071 if (energy_dec.and.wcorr5.gt.0.0d0)
9072 1 write (iout,'(a6,4i5,0pf7.3)')
9073 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
9074 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
9075 cd write(2,*)'ijkl',i,jp,i+1,jp1
9076 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
9077 & .or. wturn6.eq.0.0d0))then
9078 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
9079 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
9080 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
9081 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
9082 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
9083 cd & 'ecorr6=',ecorr6
9084 cd write (iout,'(4e15.5)') sred_geom,
9085 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
9086 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
9087 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
9088 else if (wturn6.gt.0.0d0
9089 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
9090 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
9091 eturn6=eturn6+eello_turn6(i,jj,kk)
9092 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
9093 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
9094 cd write (2,*) 'multibody_eello:eturn6',eturn6
9103 num_cont_hb(i)=num_cont_hb_old(i)
9105 c write (iout,*) "gradcorr5 in eello5"
9107 c write (iout,'(i5,3f10.5)')
9108 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
9112 c------------------------------------------------------------------------------
9113 subroutine add_hb_contact_eello(ii,jj,itask)
9114 implicit real*8 (a-h,o-z)
9115 include "DIMENSIONS"
9116 include "COMMON.IOUNITS"
9119 parameter (max_cont=maxconts)
9120 parameter (max_dim=70)
9121 include "COMMON.CONTACTS"
9122 double precision zapas(max_dim,maxconts,max_fg_procs),
9123 & zapas_recv(max_dim,maxconts,max_fg_procs)
9124 common /przechowalnia/ zapas
9125 integer i,j,ii,jj,iproc,itask(4),nn
9126 c write (iout,*) "itask",itask
9129 if (iproc.gt.0) then
9130 do j=1,num_cont_hb(ii)
9132 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
9134 ncont_sent(iproc)=ncont_sent(iproc)+1
9135 nn=ncont_sent(iproc)
9136 zapas(1,nn,iproc)=ii
9137 zapas(2,nn,iproc)=jjc
9138 zapas(3,nn,iproc)=d_cont(j,ii)
9142 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
9147 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
9155 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
9167 c------------------------------------------------------------------------------
9168 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
9169 implicit real*8 (a-h,o-z)
9170 include 'DIMENSIONS'
9171 include 'COMMON.IOUNITS'
9172 include 'COMMON.DERIV'
9173 include 'COMMON.INTERACT'
9174 include 'COMMON.CONTACTS'
9175 include 'COMMON.SHIELD'
9176 include 'COMMON.CONTROL'
9177 double precision gx(3),gx1(3)
9180 C print *,"wchodze",fac_shield(i),shield_mode
9188 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
9190 C & fac_shield(i)**2*fac_shield(j)**2
9191 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
9192 C Following 4 lines for diagnostics.
9197 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
9198 c & 'Contacts ',i,j,
9199 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
9200 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
9202 C Calculate the multi-body contribution to energy.
9203 C ecorr=ecorr+ekont*ees
9204 C Calculate multi-body contributions to the gradient.
9205 coeffpees0pij=coeffp*ees0pij
9206 coeffmees0mij=coeffm*ees0mij
9207 coeffpees0pkl=coeffp*ees0pkl
9208 coeffmees0mkl=coeffm*ees0mkl
9210 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
9211 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
9212 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
9213 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
9214 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
9215 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
9216 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
9217 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
9218 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
9219 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
9220 & coeffmees0mij*gacontm_hb1(ll,kk,k))
9221 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
9222 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
9223 & coeffmees0mij*gacontm_hb2(ll,kk,k))
9224 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
9225 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
9226 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
9227 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
9228 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
9229 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
9230 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
9231 & coeffmees0mij*gacontm_hb3(ll,kk,k))
9232 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
9233 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
9234 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
9239 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
9240 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
9241 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
9242 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
9247 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
9248 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
9249 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
9250 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
9253 c write (iout,*) "ehbcorr",ekont*ees
9254 C print *,ekont,ees,i,k
9256 C now gradient over shielding
9258 if (shield_mode.gt.0) then
9261 C print *,i,j,fac_shield(i),fac_shield(j),
9262 C &fac_shield(k),fac_shield(l)
9263 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
9264 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
9265 do ilist=1,ishield_list(i)
9266 iresshield=shield_list(ilist,i)
9268 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
9270 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
9272 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
9273 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
9277 do ilist=1,ishield_list(j)
9278 iresshield=shield_list(ilist,j)
9280 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
9282 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
9284 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
9285 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
9290 do ilist=1,ishield_list(k)
9291 iresshield=shield_list(ilist,k)
9293 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
9295 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
9297 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
9298 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
9302 do ilist=1,ishield_list(l)
9303 iresshield=shield_list(ilist,l)
9305 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
9307 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
9309 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
9310 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
9314 C print *,gshieldx(m,iresshield)
9316 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
9317 & grad_shield(m,i)*ehbcorr/fac_shield(i)
9318 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
9319 & grad_shield(m,j)*ehbcorr/fac_shield(j)
9320 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
9321 & grad_shield(m,i)*ehbcorr/fac_shield(i)
9322 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
9323 & grad_shield(m,j)*ehbcorr/fac_shield(j)
9325 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
9326 & grad_shield(m,k)*ehbcorr/fac_shield(k)
9327 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
9328 & grad_shield(m,l)*ehbcorr/fac_shield(l)
9329 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
9330 & grad_shield(m,k)*ehbcorr/fac_shield(k)
9331 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
9332 & grad_shield(m,l)*ehbcorr/fac_shield(l)
9340 C---------------------------------------------------------------------------
9341 subroutine dipole(i,j,jj)
9342 implicit real*8 (a-h,o-z)
9343 include 'DIMENSIONS'
9344 include 'COMMON.IOUNITS'
9345 include 'COMMON.CHAIN'
9346 include 'COMMON.FFIELD'
9347 include 'COMMON.DERIV'
9348 include 'COMMON.INTERACT'
9349 include 'COMMON.CONTACTS'
9350 include 'COMMON.TORSION'
9351 include 'COMMON.VAR'
9352 include 'COMMON.GEO'
9353 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
9355 iti1 = itortyp(itype(i+1))
9356 if (j.lt.nres-1) then
9357 itj1 = itype2loc(itype(j+1))
9362 dipi(iii,1)=Ub2(iii,i)
9363 dipderi(iii)=Ub2der(iii,i)
9364 dipi(iii,2)=b1(iii,i+1)
9365 dipj(iii,1)=Ub2(iii,j)
9366 dipderj(iii)=Ub2der(iii,j)
9367 dipj(iii,2)=b1(iii,j+1)
9371 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
9374 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
9381 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
9385 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
9390 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
9391 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
9393 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
9395 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
9397 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
9402 C---------------------------------------------------------------------------
9403 subroutine calc_eello(i,j,k,l,jj,kk)
9405 C This subroutine computes matrices and vectors needed to calculate
9406 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
9408 implicit real*8 (a-h,o-z)
9409 include 'DIMENSIONS'
9410 include 'COMMON.IOUNITS'
9411 include 'COMMON.CHAIN'
9412 include 'COMMON.DERIV'
9413 include 'COMMON.INTERACT'
9414 include 'COMMON.CONTACTS'
9415 include 'COMMON.TORSION'
9416 include 'COMMON.VAR'
9417 include 'COMMON.GEO'
9418 include 'COMMON.FFIELD'
9419 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
9420 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
9423 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
9424 cd & ' jj=',jj,' kk=',kk
9425 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
9426 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
9427 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
9430 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
9431 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
9434 call transpose2(aa1(1,1),aa1t(1,1))
9435 call transpose2(aa2(1,1),aa2t(1,1))
9438 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
9439 & aa1tder(1,1,lll,kkk))
9440 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
9441 & aa2tder(1,1,lll,kkk))
9445 C parallel orientation of the two CA-CA-CA frames.
9447 iti=itype2loc(itype(i))
9451 itk1=itype2loc(itype(k+1))
9452 itj=itype2loc(itype(j))
9453 if (l.lt.nres-1) then
9454 itl1=itype2loc(itype(l+1))
9458 C A1 kernel(j+1) A2T
9460 cd write (iout,'(3f10.5,5x,3f10.5)')
9461 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
9463 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9464 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
9465 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9466 C Following matrices are needed only for 6-th order cumulants
9467 IF (wcorr6.gt.0.0d0) THEN
9468 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9469 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
9470 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9471 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9472 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
9473 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9474 & ADtEAderx(1,1,1,1,1,1))
9476 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9477 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
9478 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9479 & ADtEA1derx(1,1,1,1,1,1))
9481 C End 6-th order cumulants
9484 cd write (2,*) 'In calc_eello6'
9486 cd write (2,*) 'iii=',iii
9488 cd write (2,*) 'kkk=',kkk
9490 cd write (2,'(3(2f10.5),5x)')
9491 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9496 call transpose2(EUgder(1,1,k),auxmat(1,1))
9497 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9498 call transpose2(EUg(1,1,k),auxmat(1,1))
9499 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9500 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9504 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9505 & EAEAderx(1,1,lll,kkk,iii,1))
9509 C A1T kernel(i+1) A2
9510 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9511 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
9512 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9513 C Following matrices are needed only for 6-th order cumulants
9514 IF (wcorr6.gt.0.0d0) THEN
9515 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9516 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
9517 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9518 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9519 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
9520 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9521 & ADtEAderx(1,1,1,1,1,2))
9522 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9523 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
9524 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9525 & ADtEA1derx(1,1,1,1,1,2))
9527 C End 6-th order cumulants
9528 call transpose2(EUgder(1,1,l),auxmat(1,1))
9529 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
9530 call transpose2(EUg(1,1,l),auxmat(1,1))
9531 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9532 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9536 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9537 & EAEAderx(1,1,lll,kkk,iii,2))
9542 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9543 C They are needed only when the fifth- or the sixth-order cumulants are
9545 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
9546 call transpose2(AEA(1,1,1),auxmat(1,1))
9547 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9548 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9549 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9550 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9551 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9552 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9553 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9554 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9555 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9556 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9557 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9558 call transpose2(AEA(1,1,2),auxmat(1,1))
9559 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
9560 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
9561 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
9562 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9563 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
9564 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
9565 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
9566 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
9567 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
9568 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
9569 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
9570 C Calculate the Cartesian derivatives of the vectors.
9574 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9575 call matvec2(auxmat(1,1),b1(1,i),
9576 & AEAb1derx(1,lll,kkk,iii,1,1))
9577 call matvec2(auxmat(1,1),Ub2(1,i),
9578 & AEAb2derx(1,lll,kkk,iii,1,1))
9579 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9580 & AEAb1derx(1,lll,kkk,iii,2,1))
9581 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9582 & AEAb2derx(1,lll,kkk,iii,2,1))
9583 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9584 call matvec2(auxmat(1,1),b1(1,j),
9585 & AEAb1derx(1,lll,kkk,iii,1,2))
9586 call matvec2(auxmat(1,1),Ub2(1,j),
9587 & AEAb2derx(1,lll,kkk,iii,1,2))
9588 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9589 & AEAb1derx(1,lll,kkk,iii,2,2))
9590 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
9591 & AEAb2derx(1,lll,kkk,iii,2,2))
9598 C Antiparallel orientation of the two CA-CA-CA frames.
9600 iti=itype2loc(itype(i))
9604 itk1=itype2loc(itype(k+1))
9605 itl=itype2loc(itype(l))
9606 itj=itype2loc(itype(j))
9607 if (j.lt.nres-1) then
9608 itj1=itype2loc(itype(j+1))
9612 C A2 kernel(j-1)T A1T
9613 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9614 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
9615 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9616 C Following matrices are needed only for 6-th order cumulants
9617 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9618 & j.eq.i+4 .and. l.eq.i+3)) THEN
9619 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9620 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
9621 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9622 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9623 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
9624 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9625 & ADtEAderx(1,1,1,1,1,1))
9626 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9627 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
9628 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9629 & ADtEA1derx(1,1,1,1,1,1))
9631 C End 6-th order cumulants
9632 call transpose2(EUgder(1,1,k),auxmat(1,1))
9633 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9634 call transpose2(EUg(1,1,k),auxmat(1,1))
9635 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9636 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9640 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9641 & EAEAderx(1,1,lll,kkk,iii,1))
9645 C A2T kernel(i+1)T A1
9646 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9647 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
9648 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9649 C Following matrices are needed only for 6-th order cumulants
9650 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9651 & j.eq.i+4 .and. l.eq.i+3)) THEN
9652 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9653 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
9654 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9655 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9656 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
9657 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9658 & ADtEAderx(1,1,1,1,1,2))
9659 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9660 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
9661 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9662 & ADtEA1derx(1,1,1,1,1,2))
9664 C End 6-th order cumulants
9665 call transpose2(EUgder(1,1,j),auxmat(1,1))
9666 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9667 call transpose2(EUg(1,1,j),auxmat(1,1))
9668 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9669 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9673 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9674 & EAEAderx(1,1,lll,kkk,iii,2))
9679 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9680 C They are needed only when the fifth- or the sixth-order cumulants are
9682 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
9683 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9684 call transpose2(AEA(1,1,1),auxmat(1,1))
9685 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9686 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9687 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9688 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9689 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9690 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9691 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9692 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9693 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9694 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9695 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9696 call transpose2(AEA(1,1,2),auxmat(1,1))
9697 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
9698 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9699 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9700 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9701 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
9702 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9703 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
9704 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
9705 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9706 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9707 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9708 C Calculate the Cartesian derivatives of the vectors.
9712 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9713 call matvec2(auxmat(1,1),b1(1,i),
9714 & AEAb1derx(1,lll,kkk,iii,1,1))
9715 call matvec2(auxmat(1,1),Ub2(1,i),
9716 & AEAb2derx(1,lll,kkk,iii,1,1))
9717 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9718 & AEAb1derx(1,lll,kkk,iii,2,1))
9719 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9720 & AEAb2derx(1,lll,kkk,iii,2,1))
9721 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9722 call matvec2(auxmat(1,1),b1(1,l),
9723 & AEAb1derx(1,lll,kkk,iii,1,2))
9724 call matvec2(auxmat(1,1),Ub2(1,l),
9725 & AEAb2derx(1,lll,kkk,iii,1,2))
9726 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
9727 & AEAb1derx(1,lll,kkk,iii,2,2))
9728 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
9729 & AEAb2derx(1,lll,kkk,iii,2,2))
9738 C---------------------------------------------------------------------------
9739 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
9740 & KK,KKderg,AKA,AKAderg,AKAderx)
9744 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
9745 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
9746 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
9751 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9753 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
9756 cd if (lprn) write (2,*) 'In kernel'
9758 cd if (lprn) write (2,*) 'kkk=',kkk
9760 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
9761 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9763 cd write (2,*) 'lll=',lll
9764 cd write (2,*) 'iii=1'
9766 cd write (2,'(3(2f10.5),5x)')
9767 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9770 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
9771 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9773 cd write (2,*) 'lll=',lll
9774 cd write (2,*) 'iii=2'
9776 cd write (2,'(3(2f10.5),5x)')
9777 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9784 C---------------------------------------------------------------------------
9785 double precision function eello4(i,j,k,l,jj,kk)
9786 implicit real*8 (a-h,o-z)
9787 include 'DIMENSIONS'
9788 include 'COMMON.IOUNITS'
9789 include 'COMMON.CHAIN'
9790 include 'COMMON.DERIV'
9791 include 'COMMON.INTERACT'
9792 include 'COMMON.CONTACTS'
9793 include 'COMMON.TORSION'
9794 include 'COMMON.VAR'
9795 include 'COMMON.GEO'
9796 double precision pizda(2,2),ggg1(3),ggg2(3)
9797 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9801 cd print *,'eello4:',i,j,k,l,jj,kk
9802 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9803 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9804 cold eij=facont_hb(jj,i)
9805 cold ekl=facont_hb(kk,k)
9807 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9808 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9809 gcorr_loc(k-1)=gcorr_loc(k-1)
9810 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9812 gcorr_loc(l-1)=gcorr_loc(l-1)
9813 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9815 gcorr_loc(j-1)=gcorr_loc(j-1)
9816 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9821 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9822 & -EAEAderx(2,2,lll,kkk,iii,1)
9823 cd derx(lll,kkk,iii)=0.0d0
9827 cd gcorr_loc(l-1)=0.0d0
9828 cd gcorr_loc(j-1)=0.0d0
9829 cd gcorr_loc(k-1)=0.0d0
9831 cd write (iout,*)'Contacts have occurred for peptide groups',
9832 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9833 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9834 if (j.lt.nres-1) then
9841 if (l.lt.nres-1) then
9849 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9850 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9851 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9852 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9853 cgrad ghalf=0.5d0*ggg1(ll)
9854 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9855 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9856 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9857 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9858 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9859 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9860 cgrad ghalf=0.5d0*ggg2(ll)
9861 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9862 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9863 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9864 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9865 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9866 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9870 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9875 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9880 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9885 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9889 cd write (2,*) iii,gcorr_loc(iii)
9892 cd write (2,*) 'ekont',ekont
9893 cd write (iout,*) 'eello4',ekont*eel4
9896 C---------------------------------------------------------------------------
9897 double precision function eello5(i,j,k,l,jj,kk)
9898 implicit real*8 (a-h,o-z)
9899 include 'DIMENSIONS'
9900 include 'COMMON.IOUNITS'
9901 include 'COMMON.CHAIN'
9902 include 'COMMON.DERIV'
9903 include 'COMMON.INTERACT'
9904 include 'COMMON.CONTACTS'
9905 include 'COMMON.TORSION'
9906 include 'COMMON.VAR'
9907 include 'COMMON.GEO'
9908 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9909 double precision ggg1(3),ggg2(3)
9910 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9915 C /l\ / \ \ / \ / \ / C
9916 C / \ / \ \ / \ / \ / C
9917 C j| o |l1 | o | o| o | | o |o C
9918 C \ |/k\| |/ \| / |/ \| |/ \| C
9919 C \i/ \ / \ / / \ / \ C
9921 C (I) (II) (III) (IV) C
9923 C eello5_1 eello5_2 eello5_3 eello5_4 C
9925 C Antiparallel chains C
9928 C /j\ / \ \ / \ / \ / C
9929 C / \ / \ \ / \ / \ / C
9930 C j1| o |l | o | o| o | | o |o C
9931 C \ |/k\| |/ \| / |/ \| |/ \| C
9932 C \i/ \ / \ / / \ / \ C
9934 C (I) (II) (III) (IV) C
9936 C eello5_1 eello5_2 eello5_3 eello5_4 C
9938 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9940 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9941 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9946 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9948 itk=itype2loc(itype(k))
9949 itl=itype2loc(itype(l))
9950 itj=itype2loc(itype(j))
9955 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9956 cd & eel5_3_num,eel5_4_num)
9960 derx(lll,kkk,iii)=0.0d0
9964 cd eij=facont_hb(jj,i)
9965 cd ekl=facont_hb(kk,k)
9967 cd write (iout,*)'Contacts have occurred for peptide groups',
9968 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9970 C Contribution from the graph I.
9971 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9972 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9973 call transpose2(EUg(1,1,k),auxmat(1,1))
9974 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9975 vv(1)=pizda(1,1)-pizda(2,2)
9976 vv(2)=pizda(1,2)+pizda(2,1)
9977 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9978 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9979 C Explicit gradient in virtual-dihedral angles.
9980 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9981 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9982 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9983 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9984 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9985 vv(1)=pizda(1,1)-pizda(2,2)
9986 vv(2)=pizda(1,2)+pizda(2,1)
9987 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9988 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9989 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9990 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9991 vv(1)=pizda(1,1)-pizda(2,2)
9992 vv(2)=pizda(1,2)+pizda(2,1)
9994 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9995 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9996 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9998 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9999 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
10000 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
10002 C Cartesian gradient
10006 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
10008 vv(1)=pizda(1,1)-pizda(2,2)
10009 vv(2)=pizda(1,2)+pizda(2,1)
10010 derx(lll,kkk,iii)=derx(lll,kkk,iii)
10011 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
10012 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
10018 C Contribution from graph II
10019 call transpose2(EE(1,1,k),auxmat(1,1))
10020 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
10021 vv(1)=pizda(1,1)+pizda(2,2)
10022 vv(2)=pizda(2,1)-pizda(1,2)
10023 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
10024 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
10025 C Explicit gradient in virtual-dihedral angles.
10026 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10027 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
10028 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
10029 vv(1)=pizda(1,1)+pizda(2,2)
10030 vv(2)=pizda(2,1)-pizda(1,2)
10032 g_corr5_loc(l-1)=g_corr5_loc(l-1)
10033 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
10034 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
10036 g_corr5_loc(j-1)=g_corr5_loc(j-1)
10037 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
10038 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
10040 C Cartesian gradient
10044 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
10046 vv(1)=pizda(1,1)+pizda(2,2)
10047 vv(2)=pizda(2,1)-pizda(1,2)
10048 derx(lll,kkk,iii)=derx(lll,kkk,iii)
10049 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
10050 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
10058 C Parallel orientation
10059 C Contribution from graph III
10060 call transpose2(EUg(1,1,l),auxmat(1,1))
10061 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
10062 vv(1)=pizda(1,1)-pizda(2,2)
10063 vv(2)=pizda(1,2)+pizda(2,1)
10064 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
10065 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
10066 C Explicit gradient in virtual-dihedral angles.
10067 g_corr5_loc(j-1)=g_corr5_loc(j-1)
10068 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
10069 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
10070 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
10071 vv(1)=pizda(1,1)-pizda(2,2)
10072 vv(2)=pizda(1,2)+pizda(2,1)
10073 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10074 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
10075 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
10076 call transpose2(EUgder(1,1,l),auxmat1(1,1))
10077 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
10078 vv(1)=pizda(1,1)-pizda(2,2)
10079 vv(2)=pizda(1,2)+pizda(2,1)
10080 g_corr5_loc(l-1)=g_corr5_loc(l-1)
10081 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
10082 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
10083 C Cartesian gradient
10087 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
10089 vv(1)=pizda(1,1)-pizda(2,2)
10090 vv(2)=pizda(1,2)+pizda(2,1)
10091 derx(lll,kkk,iii)=derx(lll,kkk,iii)
10092 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
10093 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
10098 C Contribution from graph IV
10100 call transpose2(EE(1,1,l),auxmat(1,1))
10101 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
10102 vv(1)=pizda(1,1)+pizda(2,2)
10103 vv(2)=pizda(2,1)-pizda(1,2)
10104 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
10105 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
10106 C Explicit gradient in virtual-dihedral angles.
10107 g_corr5_loc(l-1)=g_corr5_loc(l-1)
10108 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
10109 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
10110 vv(1)=pizda(1,1)+pizda(2,2)
10111 vv(2)=pizda(2,1)-pizda(1,2)
10112 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10113 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
10114 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
10115 C Cartesian gradient
10119 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
10121 vv(1)=pizda(1,1)+pizda(2,2)
10122 vv(2)=pizda(2,1)-pizda(1,2)
10123 derx(lll,kkk,iii)=derx(lll,kkk,iii)
10124 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
10125 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
10130 C Antiparallel orientation
10131 C Contribution from graph III
10133 call transpose2(EUg(1,1,j),auxmat(1,1))
10134 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
10135 vv(1)=pizda(1,1)-pizda(2,2)
10136 vv(2)=pizda(1,2)+pizda(2,1)
10137 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
10138 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
10139 C Explicit gradient in virtual-dihedral angles.
10140 g_corr5_loc(l-1)=g_corr5_loc(l-1)
10141 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
10142 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
10143 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
10144 vv(1)=pizda(1,1)-pizda(2,2)
10145 vv(2)=pizda(1,2)+pizda(2,1)
10146 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10147 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
10148 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
10149 call transpose2(EUgder(1,1,j),auxmat1(1,1))
10150 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
10151 vv(1)=pizda(1,1)-pizda(2,2)
10152 vv(2)=pizda(1,2)+pizda(2,1)
10153 g_corr5_loc(j-1)=g_corr5_loc(j-1)
10154 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
10155 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
10156 C Cartesian gradient
10160 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
10162 vv(1)=pizda(1,1)-pizda(2,2)
10163 vv(2)=pizda(1,2)+pizda(2,1)
10164 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
10165 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
10166 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
10171 C Contribution from graph IV
10173 call transpose2(EE(1,1,j),auxmat(1,1))
10174 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
10175 vv(1)=pizda(1,1)+pizda(2,2)
10176 vv(2)=pizda(2,1)-pizda(1,2)
10177 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
10178 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
10179 C Explicit gradient in virtual-dihedral angles.
10180 g_corr5_loc(j-1)=g_corr5_loc(j-1)
10181 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
10182 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
10183 vv(1)=pizda(1,1)+pizda(2,2)
10184 vv(2)=pizda(2,1)-pizda(1,2)
10185 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10186 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
10187 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
10188 C Cartesian gradient
10192 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
10194 vv(1)=pizda(1,1)+pizda(2,2)
10195 vv(2)=pizda(2,1)-pizda(1,2)
10196 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
10197 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
10198 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
10204 eel5=eello5_1+eello5_2+eello5_3+eello5_4
10205 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
10206 cd write (2,*) 'ijkl',i,j,k,l
10207 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
10208 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
10210 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
10211 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
10212 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
10213 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
10214 if (j.lt.nres-1) then
10221 if (l.lt.nres-1) then
10231 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
10232 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
10233 C summed up outside the subrouine as for the other subroutines
10234 C handling long-range interactions. The old code is commented out
10235 C with "cgrad" to keep track of changes.
10237 cgrad ggg1(ll)=eel5*g_contij(ll,1)
10238 cgrad ggg2(ll)=eel5*g_contij(ll,2)
10239 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
10240 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
10241 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
10242 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
10243 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
10244 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
10245 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
10246 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
10248 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
10249 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
10250 cgrad ghalf=0.5d0*ggg1(ll)
10252 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
10253 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
10254 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
10255 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
10256 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
10257 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
10258 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
10259 cgrad ghalf=0.5d0*ggg2(ll)
10261 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
10262 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
10263 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
10264 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
10265 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
10266 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
10271 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
10272 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
10277 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
10278 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
10284 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
10289 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
10293 cd write (2,*) iii,g_corr5_loc(iii)
10296 cd write (2,*) 'ekont',ekont
10297 cd write (iout,*) 'eello5',ekont*eel5
10300 c--------------------------------------------------------------------------
10301 double precision function eello6(i,j,k,l,jj,kk)
10302 implicit real*8 (a-h,o-z)
10303 include 'DIMENSIONS'
10304 include 'COMMON.IOUNITS'
10305 include 'COMMON.CHAIN'
10306 include 'COMMON.DERIV'
10307 include 'COMMON.INTERACT'
10308 include 'COMMON.CONTACTS'
10309 include 'COMMON.TORSION'
10310 include 'COMMON.VAR'
10311 include 'COMMON.GEO'
10312 include 'COMMON.FFIELD'
10313 double precision ggg1(3),ggg2(3)
10314 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10319 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10327 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
10328 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
10332 derx(lll,kkk,iii)=0.0d0
10336 cd eij=facont_hb(jj,i)
10337 cd ekl=facont_hb(kk,k)
10343 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
10344 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
10345 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
10346 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
10347 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
10348 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
10350 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
10351 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
10352 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
10353 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
10354 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
10355 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10359 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
10361 C If turn contributions are considered, they will be handled separately.
10362 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
10363 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
10364 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
10365 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
10366 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
10367 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
10368 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
10370 if (j.lt.nres-1) then
10377 if (l.lt.nres-1) then
10385 cgrad ggg1(ll)=eel6*g_contij(ll,1)
10386 cgrad ggg2(ll)=eel6*g_contij(ll,2)
10387 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
10388 cgrad ghalf=0.5d0*ggg1(ll)
10390 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
10391 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
10392 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
10393 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
10394 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
10395 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
10396 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
10397 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
10398 cgrad ghalf=0.5d0*ggg2(ll)
10399 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
10401 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
10402 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
10403 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
10404 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
10405 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
10406 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
10411 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
10412 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
10417 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
10418 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
10424 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
10429 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
10433 cd write (2,*) iii,g_corr6_loc(iii)
10436 cd write (2,*) 'ekont',ekont
10437 cd write (iout,*) 'eello6',ekont*eel6
10440 c--------------------------------------------------------------------------
10441 double precision function eello6_graph1(i,j,k,l,imat,swap)
10442 implicit real*8 (a-h,o-z)
10443 include 'DIMENSIONS'
10444 include 'COMMON.IOUNITS'
10445 include 'COMMON.CHAIN'
10446 include 'COMMON.DERIV'
10447 include 'COMMON.INTERACT'
10448 include 'COMMON.CONTACTS'
10449 include 'COMMON.TORSION'
10450 include 'COMMON.VAR'
10451 include 'COMMON.GEO'
10452 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
10455 common /kutas/ lprn
10456 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10458 C Parallel Antiparallel C
10464 C \ j|/k\| / \ |/k\|l / C
10465 C \ / \ / \ / \ / C
10469 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10470 itk=itype2loc(itype(k))
10471 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
10472 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
10473 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
10474 call transpose2(EUgC(1,1,k),auxmat(1,1))
10475 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10476 vv1(1)=pizda1(1,1)-pizda1(2,2)
10477 vv1(2)=pizda1(1,2)+pizda1(2,1)
10478 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10479 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
10480 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
10481 s5=scalar2(vv(1),Dtobr2(1,i))
10482 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
10483 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
10484 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
10485 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
10486 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
10487 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
10488 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
10489 & +scalar2(vv(1),Dtobr2der(1,i)))
10490 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
10491 vv1(1)=pizda1(1,1)-pizda1(2,2)
10492 vv1(2)=pizda1(1,2)+pizda1(2,1)
10493 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
10494 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
10496 g_corr6_loc(l-1)=g_corr6_loc(l-1)
10497 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
10498 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
10499 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
10500 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10502 g_corr6_loc(j-1)=g_corr6_loc(j-1)
10503 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
10504 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
10505 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
10506 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10508 call transpose2(EUgCder(1,1,k),auxmat(1,1))
10509 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10510 vv1(1)=pizda1(1,1)-pizda1(2,2)
10511 vv1(2)=pizda1(1,2)+pizda1(2,1)
10512 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
10513 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
10514 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
10515 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
10524 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
10525 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
10526 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
10527 call transpose2(EUgC(1,1,k),auxmat(1,1))
10528 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10530 vv1(1)=pizda1(1,1)-pizda1(2,2)
10531 vv1(2)=pizda1(1,2)+pizda1(2,1)
10532 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10533 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
10534 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
10535 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
10536 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
10537 s5=scalar2(vv(1),Dtobr2(1,i))
10538 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
10544 c----------------------------------------------------------------------------
10545 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
10546 implicit real*8 (a-h,o-z)
10547 include 'DIMENSIONS'
10548 include 'COMMON.IOUNITS'
10549 include 'COMMON.CHAIN'
10550 include 'COMMON.DERIV'
10551 include 'COMMON.INTERACT'
10552 include 'COMMON.CONTACTS'
10553 include 'COMMON.TORSION'
10554 include 'COMMON.VAR'
10555 include 'COMMON.GEO'
10557 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10558 & auxvec1(2),auxvec2(2),auxmat1(2,2)
10560 common /kutas/ lprn
10561 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10563 C Parallel Antiparallel C
10569 C \ j|/k\| \ |/k\|l C
10574 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10575 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
10576 C AL 7/4/01 s1 would occur in the sixth-order moment,
10577 C but not in a cluster cumulant
10579 s1=dip(1,jj,i)*dip(1,kk,k)
10581 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
10582 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10583 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
10584 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
10585 call transpose2(EUg(1,1,k),auxmat(1,1))
10586 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
10587 vv(1)=pizda(1,1)-pizda(2,2)
10588 vv(2)=pizda(1,2)+pizda(2,1)
10589 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10590 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10592 eello6_graph2=-(s1+s2+s3+s4)
10594 eello6_graph2=-(s2+s3+s4)
10596 c eello6_graph2=-s3
10597 C Derivatives in gamma(i-1)
10600 s1=dipderg(1,jj,i)*dip(1,kk,k)
10602 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10603 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
10604 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10605 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10607 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10609 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10611 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
10613 C Derivatives in gamma(k-1)
10615 s1=dip(1,jj,i)*dipderg(1,kk,k)
10617 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
10618 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10619 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
10620 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10621 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10622 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
10623 vv(1)=pizda(1,1)-pizda(2,2)
10624 vv(2)=pizda(1,2)+pizda(2,1)
10625 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10627 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10629 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10631 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
10632 C Derivatives in gamma(j-1) or gamma(l-1)
10635 s1=dipderg(3,jj,i)*dip(1,kk,k)
10637 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
10638 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10639 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
10640 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
10641 vv(1)=pizda(1,1)-pizda(2,2)
10642 vv(2)=pizda(1,2)+pizda(2,1)
10643 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10646 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10648 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10651 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10652 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10654 C Derivatives in gamma(l-1) or gamma(j-1)
10657 s1=dip(1,jj,i)*dipderg(3,kk,k)
10659 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10660 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10661 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10662 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10663 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10664 vv(1)=pizda(1,1)-pizda(2,2)
10665 vv(2)=pizda(1,2)+pizda(2,1)
10666 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10669 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10671 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10674 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10675 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10677 C Cartesian derivatives.
10679 write (2,*) 'In eello6_graph2'
10681 write (2,*) 'iii=',iii
10683 write (2,*) 'kkk=',kkk
10685 write (2,'(3(2f10.5),5x)')
10686 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10696 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10698 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10701 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
10703 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10704 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
10706 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10707 call transpose2(EUg(1,1,k),auxmat(1,1))
10708 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
10710 vv(1)=pizda(1,1)-pizda(2,2)
10711 vv(2)=pizda(1,2)+pizda(2,1)
10712 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10713 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10715 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10717 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10720 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10722 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10729 c----------------------------------------------------------------------------
10730 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
10731 implicit real*8 (a-h,o-z)
10732 include 'DIMENSIONS'
10733 include 'COMMON.IOUNITS'
10734 include 'COMMON.CHAIN'
10735 include 'COMMON.DERIV'
10736 include 'COMMON.INTERACT'
10737 include 'COMMON.CONTACTS'
10738 include 'COMMON.TORSION'
10739 include 'COMMON.VAR'
10740 include 'COMMON.GEO'
10741 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
10743 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10745 C Parallel Antiparallel C
10750 C /| o |o o| o |\ C
10751 C j|/k\| / |/k\|l / C
10756 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10758 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10759 C energy moment and not to the cluster cumulant.
10760 iti=itortyp(itype(i))
10761 if (j.lt.nres-1) then
10762 itj1=itype2loc(itype(j+1))
10766 itk=itype2loc(itype(k))
10767 itk1=itype2loc(itype(k+1))
10768 if (l.lt.nres-1) then
10769 itl1=itype2loc(itype(l+1))
10774 s1=dip(4,jj,i)*dip(4,kk,k)
10776 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
10777 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10778 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
10779 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10780 call transpose2(EE(1,1,k),auxmat(1,1))
10781 call matmat2(auxmat(1,1),AECA(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 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10786 cd & "sum",-(s2+s3+s4)
10788 eello6_graph3=-(s1+s2+s3+s4)
10790 eello6_graph3=-(s2+s3+s4)
10792 c eello6_graph3=-s4
10793 C Derivatives in gamma(k-1)
10794 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
10795 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10796 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10797 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10798 C Derivatives in gamma(l-1)
10799 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
10800 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10801 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10802 vv(1)=pizda(1,1)+pizda(2,2)
10803 vv(2)=pizda(2,1)-pizda(1,2)
10804 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10805 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10806 C Cartesian derivatives.
10812 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10814 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10817 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
10819 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10820 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
10822 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10823 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
10825 vv(1)=pizda(1,1)+pizda(2,2)
10826 vv(2)=pizda(2,1)-pizda(1,2)
10827 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10829 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10831 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10834 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10836 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10838 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10844 c----------------------------------------------------------------------------
10845 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10846 implicit real*8 (a-h,o-z)
10847 include 'DIMENSIONS'
10848 include 'COMMON.IOUNITS'
10849 include 'COMMON.CHAIN'
10850 include 'COMMON.DERIV'
10851 include 'COMMON.INTERACT'
10852 include 'COMMON.CONTACTS'
10853 include 'COMMON.TORSION'
10854 include 'COMMON.VAR'
10855 include 'COMMON.GEO'
10856 include 'COMMON.FFIELD'
10857 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10858 & auxvec1(2),auxmat1(2,2)
10860 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10862 C Parallel Antiparallel C
10867 C /| o |o o| o |\ C
10868 C \ j|/k\| \ |/k\|l C
10873 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10875 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10876 C energy moment and not to the cluster cumulant.
10877 cd write (2,*) 'eello_graph4: wturn6',wturn6
10878 iti=itype2loc(itype(i))
10879 itj=itype2loc(itype(j))
10880 if (j.lt.nres-1) then
10881 itj1=itype2loc(itype(j+1))
10885 itk=itype2loc(itype(k))
10886 if (k.lt.nres-1) then
10887 itk1=itype2loc(itype(k+1))
10891 itl=itype2loc(itype(l))
10892 if (l.lt.nres-1) then
10893 itl1=itype2loc(itype(l+1))
10897 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10898 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10899 cd & ' itl',itl,' itl1',itl1
10901 if (imat.eq.1) then
10902 s1=dip(3,jj,i)*dip(3,kk,k)
10904 s1=dip(2,jj,j)*dip(2,kk,l)
10907 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10908 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10910 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
10911 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10913 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
10914 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10916 call transpose2(EUg(1,1,k),auxmat(1,1))
10917 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10918 vv(1)=pizda(1,1)-pizda(2,2)
10919 vv(2)=pizda(2,1)+pizda(1,2)
10920 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10921 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10923 eello6_graph4=-(s1+s2+s3+s4)
10925 eello6_graph4=-(s2+s3+s4)
10927 C Derivatives in gamma(i-1)
10930 if (imat.eq.1) then
10931 s1=dipderg(2,jj,i)*dip(3,kk,k)
10933 s1=dipderg(4,jj,j)*dip(2,kk,l)
10936 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10938 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
10939 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10941 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
10942 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10944 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10945 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10946 cd write (2,*) 'turn6 derivatives'
10948 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10950 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10954 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10956 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10960 C Derivatives in gamma(k-1)
10962 if (imat.eq.1) then
10963 s1=dip(3,jj,i)*dipderg(2,kk,k)
10965 s1=dip(2,jj,j)*dipderg(4,kk,l)
10968 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10969 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10971 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
10972 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10974 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
10975 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10977 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10978 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10979 vv(1)=pizda(1,1)-pizda(2,2)
10980 vv(2)=pizda(2,1)+pizda(1,2)
10981 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10982 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10984 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10986 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10990 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10992 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10995 C Derivatives in gamma(j-1) or gamma(l-1)
10996 if (l.eq.j+1 .and. l.gt.1) then
10997 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10998 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10999 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
11000 vv(1)=pizda(1,1)-pizda(2,2)
11001 vv(2)=pizda(2,1)+pizda(1,2)
11002 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
11003 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
11004 else if (j.gt.1) then
11005 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
11006 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
11007 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
11008 vv(1)=pizda(1,1)-pizda(2,2)
11009 vv(2)=pizda(2,1)+pizda(1,2)
11010 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
11011 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
11012 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
11014 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
11017 C Cartesian derivatives.
11023 if (imat.eq.1) then
11024 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
11026 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
11029 if (imat.eq.1) then
11030 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
11032 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
11036 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
11038 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
11040 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
11041 & b1(1,j+1),auxvec(1))
11042 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
11044 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
11045 & b1(1,l+1),auxvec(1))
11046 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
11048 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
11050 vv(1)=pizda(1,1)-pizda(2,2)
11051 vv(2)=pizda(2,1)+pizda(1,2)
11052 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
11054 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
11056 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
11059 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
11062 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
11065 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
11067 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
11069 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
11073 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
11075 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
11078 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
11080 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
11088 c----------------------------------------------------------------------------
11089 double precision function eello_turn6(i,jj,kk)
11090 implicit real*8 (a-h,o-z)
11091 include 'DIMENSIONS'
11092 include 'COMMON.IOUNITS'
11093 include 'COMMON.CHAIN'
11094 include 'COMMON.DERIV'
11095 include 'COMMON.INTERACT'
11096 include 'COMMON.CONTACTS'
11097 include 'COMMON.TORSION'
11098 include 'COMMON.VAR'
11099 include 'COMMON.GEO'
11100 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
11101 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
11103 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
11104 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
11105 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
11106 C the respective energy moment and not to the cluster cumulant.
11115 iti=itype2loc(itype(i))
11116 itk=itype2loc(itype(k))
11117 itk1=itype2loc(itype(k+1))
11118 itl=itype2loc(itype(l))
11119 itj=itype2loc(itype(j))
11120 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
11121 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
11122 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
11127 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
11129 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
11133 derx_turn(lll,kkk,iii)=0.0d0
11140 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
11142 cd write (2,*) 'eello6_5',eello6_5
11144 call transpose2(AEA(1,1,1),auxmat(1,1))
11145 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
11146 ss1=scalar2(Ub2(1,i+2),b1(1,l))
11147 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
11149 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
11150 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
11151 s2 = scalar2(b1(1,k),vtemp1(1))
11153 call transpose2(AEA(1,1,2),atemp(1,1))
11154 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
11155 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
11156 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
11158 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
11159 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
11160 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
11162 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
11163 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
11164 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
11165 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
11166 ss13 = scalar2(b1(1,k),vtemp4(1))
11167 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
11169 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
11175 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
11176 C Derivatives in gamma(i+2)
11180 call transpose2(AEA(1,1,1),auxmatd(1,1))
11181 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
11182 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
11183 call transpose2(AEAderg(1,1,2),atempd(1,1))
11184 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
11185 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
11187 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
11188 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
11189 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
11195 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
11196 C Derivatives in gamma(i+3)
11198 call transpose2(AEA(1,1,1),auxmatd(1,1))
11199 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
11200 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
11201 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
11203 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
11204 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
11205 s2d = scalar2(b1(1,k),vtemp1d(1))
11207 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
11208 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
11210 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
11212 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
11213 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
11214 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
11222 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
11223 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
11225 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
11226 & -0.5d0*ekont*(s2d+s12d)
11228 C Derivatives in gamma(i+4)
11229 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
11230 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
11231 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
11233 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
11234 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
11235 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
11243 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
11245 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
11247 C Derivatives in gamma(i+5)
11249 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
11250 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
11251 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
11253 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
11254 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
11255 s2d = scalar2(b1(1,k),vtemp1d(1))
11257 call transpose2(AEA(1,1,2),atempd(1,1))
11258 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
11259 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
11261 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
11262 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
11264 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
11265 ss13d = scalar2(b1(1,k),vtemp4d(1))
11266 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
11274 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
11275 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
11277 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
11278 & -0.5d0*ekont*(s2d+s12d)
11280 C Cartesian derivatives
11285 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
11286 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
11287 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
11289 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
11290 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
11292 s2d = scalar2(b1(1,k),vtemp1d(1))
11294 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
11295 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
11296 s8d = -(atempd(1,1)+atempd(2,2))*
11297 & scalar2(cc(1,1,itl),vtemp2(1))
11299 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
11301 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
11302 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
11309 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
11310 & - 0.5d0*(s1d+s2d)
11312 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
11316 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
11317 & - 0.5d0*(s8d+s12d)
11319 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
11328 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
11329 & achuj_tempd(1,1))
11330 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
11331 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
11332 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
11333 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
11334 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
11336 ss13d = scalar2(b1(1,k),vtemp4d(1))
11337 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
11338 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
11342 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
11343 cd & 16*eel_turn6_num
11345 if (j.lt.nres-1) then
11352 if (l.lt.nres-1) then
11360 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
11361 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
11362 cgrad ghalf=0.5d0*ggg1(ll)
11364 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
11365 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
11366 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
11367 & +ekont*derx_turn(ll,2,1)
11368 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
11369 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
11370 & +ekont*derx_turn(ll,4,1)
11371 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
11372 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
11373 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
11374 cgrad ghalf=0.5d0*ggg2(ll)
11376 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
11377 & +ekont*derx_turn(ll,2,2)
11378 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
11379 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
11380 & +ekont*derx_turn(ll,4,2)
11381 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
11382 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
11383 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
11388 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
11393 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
11399 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
11404 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
11408 cd write (2,*) iii,g_corr6_loc(iii)
11410 eello_turn6=ekont*eel_turn6
11411 cd write (2,*) 'ekont',ekont
11412 cd write (2,*) 'eel_turn6',ekont*eel_turn6
11416 C-----------------------------------------------------------------------------
11417 double precision function scalar(u,v)
11418 !DIR$ INLINEALWAYS scalar
11420 cDEC$ ATTRIBUTES FORCEINLINE::scalar
11423 double precision u(3),v(3)
11424 cd double precision sc
11432 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
11435 crc-------------------------------------------------
11436 SUBROUTINE MATVEC2(A1,V1,V2)
11437 !DIR$ INLINEALWAYS MATVEC2
11439 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
11441 implicit real*8 (a-h,o-z)
11442 include 'DIMENSIONS'
11443 DIMENSION A1(2,2),V1(2),V2(2)
11447 c 3 VI=VI+A1(I,K)*V1(K)
11451 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
11452 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
11457 C---------------------------------------
11458 SUBROUTINE MATMAT2(A1,A2,A3)
11460 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
11462 implicit real*8 (a-h,o-z)
11463 include 'DIMENSIONS'
11464 DIMENSION A1(2,2),A2(2,2),A3(2,2)
11465 c DIMENSION AI3(2,2)
11469 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
11475 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
11476 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
11477 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
11478 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
11486 c-------------------------------------------------------------------------
11487 double precision function scalar2(u,v)
11488 !DIR$ INLINEALWAYS scalar2
11490 double precision u(2),v(2)
11491 double precision sc
11493 scalar2=u(1)*v(1)+u(2)*v(2)
11497 C-----------------------------------------------------------------------------
11499 subroutine transpose2(a,at)
11500 !DIR$ INLINEALWAYS transpose2
11502 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
11505 double precision a(2,2),at(2,2)
11512 c--------------------------------------------------------------------------
11513 subroutine transpose(n,a,at)
11516 double precision a(n,n),at(n,n)
11524 C---------------------------------------------------------------------------
11525 subroutine prodmat3(a1,a2,kk,transp,prod)
11526 !DIR$ INLINEALWAYS prodmat3
11528 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
11532 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
11534 crc double precision auxmat(2,2),prod_(2,2)
11537 crc call transpose2(kk(1,1),auxmat(1,1))
11538 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
11539 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11541 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
11542 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
11543 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
11544 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
11545 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
11546 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
11547 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
11548 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
11551 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
11552 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11554 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
11555 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
11556 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
11557 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
11558 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
11559 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
11560 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
11561 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
11564 c call transpose2(a2(1,1),a2t(1,1))
11567 crc print *,((prod_(i,j),i=1,2),j=1,2)
11568 crc print *,((prod(i,j),i=1,2),j=1,2)
11572 CCC----------------------------------------------
11573 subroutine Eliptransfer(eliptran)
11574 implicit real*8 (a-h,o-z)
11575 include 'DIMENSIONS'
11576 include 'COMMON.GEO'
11577 include 'COMMON.VAR'
11578 include 'COMMON.LOCAL'
11579 include 'COMMON.CHAIN'
11580 include 'COMMON.DERIV'
11581 include 'COMMON.NAMES'
11582 include 'COMMON.INTERACT'
11583 include 'COMMON.IOUNITS'
11584 include 'COMMON.CALC'
11585 include 'COMMON.CONTROL'
11586 include 'COMMON.SPLITELE'
11587 include 'COMMON.SBRIDGE'
11588 C this is done by Adasko
11589 C print *,"wchodze"
11590 C structure of box:
11592 C--bordliptop-- buffore starts
11593 C--bufliptop--- here true lipid starts
11595 C--buflipbot--- lipid ends buffore starts
11596 C--bordlipbot--buffore ends
11598 do i=ilip_start,ilip_end
11600 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1).or.(i.eq.nres))
11603 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
11604 if (positi.le.0.0) positi=positi+boxzsize
11606 C first for peptide groups
11607 c for each residue check if it is in lipid or lipid water border area
11608 if ((positi.gt.bordlipbot)
11609 &.and.(positi.lt.bordliptop)) then
11610 C the energy transfer exist
11611 if (positi.lt.buflipbot) then
11612 C what fraction I am in
11614 & ((positi-bordlipbot)/lipbufthick)
11615 C lipbufthick is thickenes of lipid buffore
11616 sslip=sscalelip(fracinbuf)
11617 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11618 eliptran=eliptran+sslip*pepliptran
11619 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11620 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11621 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11623 C print *,"doing sccale for lower part"
11624 C print *,i,sslip,fracinbuf,ssgradlip
11625 elseif (positi.gt.bufliptop) then
11626 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
11627 sslip=sscalelip(fracinbuf)
11628 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11629 eliptran=eliptran+sslip*pepliptran
11630 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11631 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11632 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11633 C print *, "doing sscalefor top part"
11634 C print *,i,sslip,fracinbuf,ssgradlip
11636 eliptran=eliptran+pepliptran
11637 C print *,"I am in true lipid"
11640 C eliptran=elpitran+0.0 ! I am in water
11643 C print *, "nic nie bylo w lipidzie?"
11644 C now multiply all by the peptide group transfer factor
11645 C eliptran=eliptran*pepliptran
11646 C now the same for side chains
11648 do i=ilip_start,ilip_end
11649 if (itype(i).eq.ntyp1) cycle
11650 positi=(mod(c(3,i+nres),boxzsize))
11651 if (positi.le.0) positi=positi+boxzsize
11652 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
11653 c for each residue check if it is in lipid or lipid water border area
11654 C respos=mod(c(3,i+nres),boxzsize)
11655 C print *,positi,bordlipbot,buflipbot
11656 if ((positi.gt.bordlipbot)
11657 & .and.(positi.lt.bordliptop)) then
11658 C the energy transfer exist
11659 if (positi.lt.buflipbot) then
11661 & ((positi-bordlipbot)/lipbufthick)
11662 C lipbufthick is thickenes of lipid buffore
11663 sslip=sscalelip(fracinbuf)
11664 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11665 eliptran=eliptran+sslip*liptranene(itype(i))
11666 gliptranx(3,i)=gliptranx(3,i)
11667 &+ssgradlip*liptranene(itype(i))
11668 gliptranc(3,i-1)= gliptranc(3,i-1)
11669 &+ssgradlip*liptranene(itype(i))
11670 C print *,"doing sccale for lower part"
11671 elseif (positi.gt.bufliptop) then
11673 &((bordliptop-positi)/lipbufthick)
11674 sslip=sscalelip(fracinbuf)
11675 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11676 eliptran=eliptran+sslip*liptranene(itype(i))
11677 gliptranx(3,i)=gliptranx(3,i)
11678 &+ssgradlip*liptranene(itype(i))
11679 gliptranc(3,i-1)= gliptranc(3,i-1)
11680 &+ssgradlip*liptranene(itype(i))
11681 C print *, "doing sscalefor top part",sslip,fracinbuf
11683 eliptran=eliptran+liptranene(itype(i))
11684 C print *,"I am in true lipid"
11686 endif ! if in lipid or buffor
11688 C eliptran=elpitran+0.0 ! I am in water
11692 C---------------------------------------------------------
11693 C AFM soubroutine for constant force
11694 subroutine AFMforce(Eafmforce)
11695 implicit real*8 (a-h,o-z)
11696 include 'DIMENSIONS'
11697 include 'COMMON.GEO'
11698 include 'COMMON.VAR'
11699 include 'COMMON.LOCAL'
11700 include 'COMMON.CHAIN'
11701 include 'COMMON.DERIV'
11702 include 'COMMON.NAMES'
11703 include 'COMMON.INTERACT'
11704 include 'COMMON.IOUNITS'
11705 include 'COMMON.CALC'
11706 include 'COMMON.CONTROL'
11707 include 'COMMON.SPLITELE'
11708 include 'COMMON.SBRIDGE'
11713 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11714 dist=dist+diffafm(i)**2
11717 Eafmforce=-forceAFMconst*(dist-distafminit)
11719 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
11720 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
11722 C print *,'AFM',Eafmforce
11725 C---------------------------------------------------------
11726 C AFM subroutine with pseudoconstant velocity
11727 subroutine AFMvel(Eafmforce)
11728 implicit real*8 (a-h,o-z)
11729 include 'DIMENSIONS'
11730 include 'COMMON.GEO'
11731 include 'COMMON.VAR'
11732 include 'COMMON.LOCAL'
11733 include 'COMMON.CHAIN'
11734 include 'COMMON.DERIV'
11735 include 'COMMON.NAMES'
11736 include 'COMMON.INTERACT'
11737 include 'COMMON.IOUNITS'
11738 include 'COMMON.CALC'
11739 include 'COMMON.CONTROL'
11740 include 'COMMON.SPLITELE'
11741 include 'COMMON.SBRIDGE'
11743 C Only for check grad COMMENT if not used for checkgrad
11745 C--------------------------------------------------------
11746 C print *,"wchodze"
11750 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11751 dist=dist+diffafm(i)**2
11754 Eafmforce=0.5d0*forceAFMconst
11755 & *(distafminit+totTafm*velAFMconst-dist)**2
11756 C Eafmforce=-forceAFMconst*(dist-distafminit)
11758 gradafm(i,afmend-1)=-forceAFMconst*
11759 &(distafminit+totTafm*velAFMconst-dist)
11761 gradafm(i,afmbeg-1)=forceAFMconst*
11762 &(distafminit+totTafm*velAFMconst-dist)
11765 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
11768 C-----------------------------------------------------------
11769 C first for shielding is setting of function of side-chains
11770 subroutine set_shield_fac
11771 implicit real*8 (a-h,o-z)
11772 include 'DIMENSIONS'
11773 include 'COMMON.CHAIN'
11774 include 'COMMON.DERIV'
11775 include 'COMMON.IOUNITS'
11776 include 'COMMON.SHIELD'
11777 include 'COMMON.INTERACT'
11778 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11779 double precision div77_81/0.974996043d0/,
11780 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11782 C the vector between center of side_chain and peptide group
11783 double precision pep_side(3),long,side_calf(3),
11784 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11785 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11786 C the line belowe needs to be changed for FGPROC>1
11788 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11790 Cif there two consequtive dummy atoms there is no peptide group between them
11791 C the line below has to be changed for FGPROC>1
11794 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11798 C first lets set vector conecting the ithe side-chain with kth side-chain
11799 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11800 C pep_side(j)=2.0d0
11801 C and vector conecting the side-chain with its proper calfa
11802 side_calf(j)=c(j,k+nres)-c(j,k)
11803 C side_calf(j)=2.0d0
11804 pept_group(j)=c(j,i)-c(j,i+1)
11805 C lets have their lenght
11806 dist_pep_side=pep_side(j)**2+dist_pep_side
11807 dist_side_calf=dist_side_calf+side_calf(j)**2
11808 dist_pept_group=dist_pept_group+pept_group(j)**2
11810 dist_pep_side=dsqrt(dist_pep_side)
11811 dist_pept_group=dsqrt(dist_pept_group)
11812 dist_side_calf=dsqrt(dist_side_calf)
11814 pep_side_norm(j)=pep_side(j)/dist_pep_side
11815 side_calf_norm(j)=dist_side_calf
11817 C now sscale fraction
11818 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
11819 C print *,buff_shield,"buff"
11821 if (sh_frac_dist.le.0.0) cycle
11822 C If we reach here it means that this side chain reaches the shielding sphere
11823 C Lets add him to the list for gradient
11824 ishield_list(i)=ishield_list(i)+1
11825 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
11826 C this list is essential otherwise problem would be O3
11827 shield_list(ishield_list(i),i)=k
11828 C Lets have the sscale value
11829 if (sh_frac_dist.gt.1.0) then
11830 scale_fac_dist=1.0d0
11832 sh_frac_dist_grad(j)=0.0d0
11835 scale_fac_dist=-sh_frac_dist*sh_frac_dist
11836 & *(2.0*sh_frac_dist-3.0d0)
11837 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
11838 & /dist_pep_side/buff_shield*0.5
11839 C remember for the final gradient multiply sh_frac_dist_grad(j)
11840 C for side_chain by factor -2 !
11842 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
11843 C print *,"jestem",scale_fac_dist,fac_help_scale,
11844 C & sh_frac_dist_grad(j)
11847 C if ((i.eq.3).and.(k.eq.2)) then
11848 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
11852 C this is what is now we have the distance scaling now volume...
11853 short=short_r_sidechain(itype(k))
11854 long=long_r_sidechain(itype(k))
11855 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
11858 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
11859 C costhet_fac=0.0d0
11861 costhet_grad(j)=costhet_fac*pep_side(j)
11863 C remember for the final gradient multiply costhet_grad(j)
11864 C for side_chain by factor -2 !
11865 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
11866 C pep_side0pept_group is vector multiplication
11867 pep_side0pept_group=0.0
11869 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
11871 cosalfa=(pep_side0pept_group/
11872 & (dist_pep_side*dist_side_calf))
11873 fac_alfa_sin=1.0-cosalfa**2
11874 fac_alfa_sin=dsqrt(fac_alfa_sin)
11875 rkprim=fac_alfa_sin*(long-short)+short
11877 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
11878 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
11881 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
11882 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11883 &*(long-short)/fac_alfa_sin*cosalfa/
11884 &((dist_pep_side*dist_side_calf))*
11885 &((side_calf(j))-cosalfa*
11886 &((pep_side(j)/dist_pep_side)*dist_side_calf))
11888 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11889 &*(long-short)/fac_alfa_sin*cosalfa
11890 &/((dist_pep_side*dist_side_calf))*
11892 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
11895 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
11898 C now the gradient...
11899 C grad_shield is gradient of Calfa for peptide groups
11900 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
11902 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
11903 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
11905 grad_shield(j,i)=grad_shield(j,i)
11906 C gradient po skalowaniu
11907 & +(sh_frac_dist_grad(j)
11908 C gradient po costhet
11909 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
11910 &-scale_fac_dist*(cosphi_grad_long(j))
11911 &/(1.0-cosphi) )*div77_81
11913 C grad_shield_side is Cbeta sidechain gradient
11914 grad_shield_side(j,ishield_list(i),i)=
11915 & (sh_frac_dist_grad(j)*-2.0d0
11916 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
11917 & +scale_fac_dist*(cosphi_grad_long(j))
11918 & *2.0d0/(1.0-cosphi))
11919 & *div77_81*VofOverlap
11921 grad_shield_loc(j,ishield_list(i),i)=
11922 & scale_fac_dist*cosphi_grad_loc(j)
11923 & *2.0d0/(1.0-cosphi)
11924 & *div77_81*VofOverlap
11926 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
11928 fac_shield(i)=VolumeTotal*div77_81+div4_81
11929 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
11933 C--------------------------------------------------------------------------
11934 double precision function tschebyshev(m,n,x,y)
11936 include "DIMENSIONS"
11938 double precision x(n),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*yy(1)*yy(i-1)-yy(i-2)
11954 C--------------------------------------------------------------------------
11955 double precision function gradtschebyshev(m,n,x,y)
11957 include "DIMENSIONS"
11959 double precision x(n+1),y,yy(0:maxvar),aux
11960 c Tschebyshev polynomial. Note that the first term is omitted
11961 c m=0: the constant term is included
11962 c m=1: the constant term is not included
11966 yy(i)=2*y*yy(i-1)-yy(i-2)
11970 aux=aux+x(i+1)*yy(i)*(i+1)
11971 C print *, x(i+1),yy(i),i
11973 gradtschebyshev=aux
11976 C------------------------------------------------------------------------
11977 C first for shielding is setting of function of side-chains
11978 subroutine set_shield_fac2
11979 implicit real*8 (a-h,o-z)
11980 include 'DIMENSIONS'
11981 include 'COMMON.CHAIN'
11982 include 'COMMON.DERIV'
11983 include 'COMMON.IOUNITS'
11984 include 'COMMON.SHIELD'
11985 include 'COMMON.INTERACT'
11986 include 'COMMON.LOCAL'
11988 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11989 double precision div77_81/0.974996043d0/,
11990 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11992 C the vector between center of side_chain and peptide group
11993 double precision pep_side(3),long,side_calf(3),
11994 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11995 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11996 C write(2,*) "ivec",ivec_start,ivec_end
11998 fac_shield(i)=0.0d0
12000 grad_shield(j,i)=0.0d0
12003 C the line belowe needs to be changed for FGPROC>1
12004 do i=ivec_start,ivec_end
12006 C if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
12008 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
12009 Cif there two consequtive dummy atoms there is no peptide group between them
12010 C the line below has to be changed for FGPROC>1
12013 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
12017 C first lets set vector conecting the ithe side-chain with kth side-chain
12018 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
12019 C pep_side(j)=2.0d0
12020 C and vector conecting the side-chain with its proper calfa
12021 side_calf(j)=c(j,k+nres)-c(j,k)
12022 C side_calf(j)=2.0d0
12023 pept_group(j)=c(j,i)-c(j,i+1)
12024 C lets have their lenght
12025 dist_pep_side=pep_side(j)**2+dist_pep_side
12026 dist_side_calf=dist_side_calf+side_calf(j)**2
12027 dist_pept_group=dist_pept_group+pept_group(j)**2
12029 dist_pep_side=dsqrt(dist_pep_side)
12030 dist_pept_group=dsqrt(dist_pept_group)
12031 dist_side_calf=dsqrt(dist_side_calf)
12033 pep_side_norm(j)=pep_side(j)/dist_pep_side
12034 side_calf_norm(j)=dist_side_calf
12036 C now sscale fraction
12037 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
12038 C print *,buff_shield,"buff"
12040 if (sh_frac_dist.le.0.0) cycle
12041 C print *,ishield_list(i),i
12042 C If we reach here it means that this side chain reaches the shielding sphere
12043 C Lets add him to the list for gradient
12044 ishield_list(i)=ishield_list(i)+1
12045 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
12046 C this list is essential otherwise problem would be O3
12047 shield_list(ishield_list(i),i)=k
12048 C Lets have the sscale value
12049 if (sh_frac_dist.gt.1.0) then
12050 scale_fac_dist=1.0d0
12052 sh_frac_dist_grad(j)=0.0d0
12055 scale_fac_dist=-sh_frac_dist*sh_frac_dist
12056 & *(2.0d0*sh_frac_dist-3.0d0)
12057 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
12058 & /dist_pep_side/buff_shield*0.5d0
12059 C remember for the final gradient multiply sh_frac_dist_grad(j)
12060 C for side_chain by factor -2 !
12062 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
12063 C sh_frac_dist_grad(j)=0.0d0
12064 C scale_fac_dist=1.0d0
12065 C print *,"jestem",scale_fac_dist,fac_help_scale,
12066 C & sh_frac_dist_grad(j)
12069 C this is what is now we have the distance scaling now volume...
12070 short=short_r_sidechain(itype(k))
12071 long=long_r_sidechain(itype(k))
12072 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
12073 sinthet=short/dist_pep_side*costhet
12077 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
12078 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
12079 C & -short/dist_pep_side**2/costhet)
12080 C costhet_fac=0.0d0
12082 costhet_grad(j)=costhet_fac*pep_side(j)
12084 C remember for the final gradient multiply costhet_grad(j)
12085 C for side_chain by factor -2 !
12086 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
12087 C pep_side0pept_group is vector multiplication
12088 pep_side0pept_group=0.0d0
12090 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
12092 cosalfa=(pep_side0pept_group/
12093 & (dist_pep_side*dist_side_calf))
12094 fac_alfa_sin=1.0d0-cosalfa**2
12095 fac_alfa_sin=dsqrt(fac_alfa_sin)
12096 rkprim=fac_alfa_sin*(long-short)+short
12100 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
12102 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
12103 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
12104 & dist_pep_side**2)
12107 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
12108 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
12109 &*(long-short)/fac_alfa_sin*cosalfa/
12110 &((dist_pep_side*dist_side_calf))*
12111 &((side_calf(j))-cosalfa*
12112 &((pep_side(j)/dist_pep_side)*dist_side_calf))
12113 C cosphi_grad_long(j)=0.0d0
12114 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
12115 &*(long-short)/fac_alfa_sin*cosalfa
12116 &/((dist_pep_side*dist_side_calf))*
12118 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
12119 C cosphi_grad_loc(j)=0.0d0
12121 C print *,sinphi,sinthet
12122 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
12125 C now the gradient...
12127 grad_shield(j,i)=grad_shield(j,i)
12128 C gradient po skalowaniu
12129 & +(sh_frac_dist_grad(j)*VofOverlap
12130 C gradient po costhet
12131 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
12132 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
12133 & sinphi/sinthet*costhet*costhet_grad(j)
12134 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
12136 C grad_shield_side is Cbeta sidechain gradient
12137 grad_shield_side(j,ishield_list(i),i)=
12138 & (sh_frac_dist_grad(j)*-2.0d0
12140 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
12141 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
12142 & sinphi/sinthet*costhet*costhet_grad(j)
12143 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
12146 grad_shield_loc(j,ishield_list(i),i)=
12147 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
12148 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
12149 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
12153 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
12155 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
12156 C write(2,*) "TOTAL VOLUME",i,itype(i),fac_shield(i)
12160 C-----------------------------------------------------------------------
12161 C-----------------------------------------------------------
12162 C This subroutine is to mimic the histone like structure but as well can be
12163 C utilizet to nanostructures (infinit) small modification has to be used to
12164 C make it finite (z gradient at the ends has to be changes as well as the x,y
12165 C gradient has to be modified at the ends
12166 C The energy function is Kihara potential
12167 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
12168 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
12169 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
12170 C simple Kihara potential
12171 subroutine calctube(Etube)
12172 implicit real*8 (a-h,o-z)
12173 include 'DIMENSIONS'
12174 include 'COMMON.GEO'
12175 include 'COMMON.VAR'
12176 include 'COMMON.LOCAL'
12177 include 'COMMON.CHAIN'
12178 include 'COMMON.DERIV'
12179 include 'COMMON.NAMES'
12180 include 'COMMON.INTERACT'
12181 include 'COMMON.IOUNITS'
12182 include 'COMMON.CALC'
12183 include 'COMMON.CONTROL'
12184 include 'COMMON.SPLITELE'
12185 include 'COMMON.SBRIDGE'
12186 double precision tub_r,vectube(3),enetube(maxres*2)
12188 do i=itube_start,itube_end
12190 enetube(i+nres)=0.0d0
12192 C first we calculate the distance from tube center
12193 C first sugare-phosphate group for NARES this would be peptide group
12195 do i=itube_start,itube_end
12196 C lets ommit dummy atoms for now
12197 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
12198 C now calculate distance from center of tube and direction vectors
12202 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
12203 vectube(1)=vectube(1)+boxxsize*j
12204 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
12205 vectube(2)=vectube(2)+boxysize*j
12207 xminact=abs(vectube(1)-tubecenter(1))
12208 yminact=abs(vectube(2)-tubecenter(2))
12209 if (xmin.gt.xminact) then
12213 if (ymin.gt.yminact) then
12220 vectube(1)=vectube(1)-tubecenter(1)
12221 vectube(2)=vectube(2)-tubecenter(2)
12223 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
12224 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
12226 C as the tube is infinity we do not calculate the Z-vector use of Z
12229 C now calculte the distance
12230 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12231 C now normalize vector
12232 vectube(1)=vectube(1)/tub_r
12233 vectube(2)=vectube(2)/tub_r
12234 C calculte rdiffrence between r and r0
12237 rdiff6=rdiff**6.0d0
12238 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12239 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
12240 C write(iout,*) "TU13",i,rdiff6,enetube(i)
12241 C print *,rdiff,rdiff6,pep_aa_tube
12242 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12243 C now we calculate gradient
12244 fac=(-12.0d0*pep_aa_tube/rdiff6-
12245 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
12246 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
12249 C now direction of gg_tube vector
12251 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
12252 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
12255 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
12256 C print *,gg_tube(1,0),"TU"
12259 do i=itube_start,itube_end
12260 C Lets not jump over memory as we use many times iti
12262 C lets ommit dummy atoms for now
12264 C in UNRES uncomment the line below as GLY has no side-chain...
12270 vectube(1)=mod((c(1,i+nres)),boxxsize)
12271 vectube(1)=vectube(1)+boxxsize*j
12272 vectube(2)=mod((c(2,i+nres)),boxysize)
12273 vectube(2)=vectube(2)+boxysize*j
12275 xminact=abs(vectube(1)-tubecenter(1))
12276 yminact=abs(vectube(2)-tubecenter(2))
12277 if (xmin.gt.xminact) then
12281 if (ymin.gt.yminact) then
12288 C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
12290 vectube(1)=vectube(1)-tubecenter(1)
12291 vectube(2)=vectube(2)-tubecenter(2)
12293 C as the tube is infinity we do not calculate the Z-vector use of Z
12296 C now calculte the distance
12297 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12298 C now normalize vector
12299 vectube(1)=vectube(1)/tub_r
12300 vectube(2)=vectube(2)/tub_r
12302 C calculte rdiffrence between r and r0
12305 rdiff6=rdiff**6.0d0
12306 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12307 sc_aa_tube=sc_aa_tube_par(iti)
12308 sc_bb_tube=sc_bb_tube_par(iti)
12309 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
12310 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12311 C now we calculate gradient
12312 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
12313 & 6.0d0*sc_bb_tube/rdiff6/rdiff
12314 C now direction of gg_tube vector
12316 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
12317 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
12320 do i=itube_start,itube_end
12321 Etube=Etube+enetube(i)+enetube(i+nres)
12323 C print *,"ETUBE", etube
12326 C TO DO 1) add to total energy
12327 C 2) add to gradient summation
12328 C 3) add reading parameters (AND of course oppening of PARAM file)
12329 C 4) add reading the center of tube
12331 C 6) add to zerograd
12333 C-----------------------------------------------------------------------
12334 C-----------------------------------------------------------
12335 C This subroutine is to mimic the histone like structure but as well can be
12336 C utilizet to nanostructures (infinit) small modification has to be used to
12337 C make it finite (z gradient at the ends has to be changes as well as the x,y
12338 C gradient has to be modified at the ends
12339 C The energy function is Kihara potential
12340 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
12341 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
12342 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
12343 C simple Kihara potential
12344 subroutine calctube2(Etube)
12345 implicit real*8 (a-h,o-z)
12346 include 'DIMENSIONS'
12347 include 'COMMON.GEO'
12348 include 'COMMON.VAR'
12349 include 'COMMON.LOCAL'
12350 include 'COMMON.CHAIN'
12351 include 'COMMON.DERIV'
12352 include 'COMMON.NAMES'
12353 include 'COMMON.INTERACT'
12354 include 'COMMON.IOUNITS'
12355 include 'COMMON.CALC'
12356 include 'COMMON.CONTROL'
12357 include 'COMMON.SPLITELE'
12358 include 'COMMON.SBRIDGE'
12359 double precision tub_r,vectube(3),enetube(maxres*2)
12361 do i=itube_start,itube_end
12363 enetube(i+nres)=0.0d0
12365 C first we calculate the distance from tube center
12366 C first sugare-phosphate group for NARES this would be peptide group
12368 do i=itube_start,itube_end
12369 C lets ommit dummy atoms for now
12371 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
12372 C now calculate distance from center of tube and direction vectors
12373 C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
12374 C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
12375 C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
12376 C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
12380 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
12381 vectube(1)=vectube(1)+boxxsize*j
12382 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
12383 vectube(2)=vectube(2)+boxysize*j
12385 xminact=abs(vectube(1)-tubecenter(1))
12386 yminact=abs(vectube(2)-tubecenter(2))
12387 if (xmin.gt.xminact) then
12391 if (ymin.gt.yminact) then
12398 vectube(1)=vectube(1)-tubecenter(1)
12399 vectube(2)=vectube(2)-tubecenter(2)
12401 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
12402 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
12404 C as the tube is infinity we do not calculate the Z-vector use of Z
12407 C now calculte the distance
12408 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12409 C now normalize vector
12410 vectube(1)=vectube(1)/tub_r
12411 vectube(2)=vectube(2)/tub_r
12412 C calculte rdiffrence between r and r0
12415 rdiff6=rdiff**6.0d0
12416 C THIS FRAGMENT MAKES TUBE FINITE
12417 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
12418 if (positi.le.0) positi=positi+boxzsize
12419 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
12420 c for each residue check if it is in lipid or lipid water border area
12421 C respos=mod(c(3,i+nres),boxzsize)
12422 C print *,positi,bordtubebot,buftubebot,bordtubetop
12423 if ((positi.gt.bordtubebot)
12424 & .and.(positi.lt.bordtubetop)) then
12425 C the energy transfer exist
12426 if (positi.lt.buftubebot) then
12428 & ((positi-bordtubebot)/tubebufthick)
12429 C lipbufthick is thickenes of lipid buffore
12430 sstube=sscalelip(fracinbuf)
12431 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
12432 C print *,ssgradtube, sstube,tubetranene(itype(i))
12433 enetube(i)=enetube(i)+sstube*tubetranenepep
12434 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
12435 C &+ssgradtube*tubetranene(itype(i))
12436 C gg_tube(3,i-1)= gg_tube(3,i-1)
12437 C &+ssgradtube*tubetranene(itype(i))
12438 C print *,"doing sccale for lower part"
12439 elseif (positi.gt.buftubetop) then
12441 &((bordtubetop-positi)/tubebufthick)
12442 sstube=sscalelip(fracinbuf)
12443 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
12444 enetube(i)=enetube(i)+sstube*tubetranenepep
12445 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
12446 C &+ssgradtube*tubetranene(itype(i))
12447 C gg_tube(3,i-1)= gg_tube(3,i-1)
12448 C &+ssgradtube*tubetranene(itype(i))
12449 C print *, "doing sscalefor top part",sslip,fracinbuf
12453 enetube(i)=enetube(i)+sstube*tubetranenepep
12454 C print *,"I am in true lipid"
12460 endif ! if in lipid or buffor
12462 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12463 enetube(i)=enetube(i)+sstube*
12464 &(pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
12465 C write(iout,*) "TU13",i,rdiff6,enetube(i)
12466 C print *,rdiff,rdiff6,pep_aa_tube
12467 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12468 C now we calculate gradient
12469 fac=(-12.0d0*pep_aa_tube/rdiff6-
12470 & 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
12471 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
12474 C now direction of gg_tube vector
12476 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
12477 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
12479 gg_tube(3,i)=gg_tube(3,i)
12480 &+ssgradtube*enetube(i)/sstube/2.0d0
12481 gg_tube(3,i-1)= gg_tube(3,i-1)
12482 &+ssgradtube*enetube(i)/sstube/2.0d0
12485 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
12486 C print *,gg_tube(1,0),"TU"
12487 do i=itube_start,itube_end
12488 C Lets not jump over memory as we use many times iti
12490 C lets ommit dummy atoms for now
12492 C in UNRES uncomment the line below as GLY has no side-chain...
12495 vectube(1)=c(1,i+nres)
12496 vectube(1)=mod(vectube(1),boxxsize)
12497 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
12498 vectube(2)=c(2,i+nres)
12499 vectube(2)=mod(vectube(2),boxysize)
12500 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
12502 vectube(1)=vectube(1)-tubecenter(1)
12503 vectube(2)=vectube(2)-tubecenter(2)
12504 C THIS FRAGMENT MAKES TUBE FINITE
12505 positi=(mod(c(3,i+nres),boxzsize))
12506 if (positi.le.0) positi=positi+boxzsize
12507 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
12508 c for each residue check if it is in lipid or lipid water border area
12509 C respos=mod(c(3,i+nres),boxzsize)
12510 C print *,positi,bordtubebot,buftubebot,bordtubetop
12512 if ((positi.gt.bordtubebot)
12513 & .and.(positi.lt.bordtubetop)) then
12514 C the energy transfer exist
12515 if (positi.lt.buftubebot) then
12517 & ((positi-bordtubebot)/tubebufthick)
12518 C lipbufthick is thickenes of lipid buffore
12519 sstube=sscalelip(fracinbuf)
12520 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
12521 C print *,ssgradtube, sstube,tubetranene(itype(i))
12522 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
12523 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
12524 C &+ssgradtube*tubetranene(itype(i))
12525 C gg_tube(3,i-1)= gg_tube(3,i-1)
12526 C &+ssgradtube*tubetranene(itype(i))
12527 C print *,"doing sccale for lower part"
12528 elseif (positi.gt.buftubetop) then
12530 &((bordtubetop-positi)/tubebufthick)
12531 sstube=sscalelip(fracinbuf)
12532 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
12533 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
12534 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
12535 C &+ssgradtube*tubetranene(itype(i))
12536 C gg_tube(3,i-1)= gg_tube(3,i-1)
12537 C &+ssgradtube*tubetranene(itype(i))
12538 C print *, "doing sscalefor top part",sslip,fracinbuf
12542 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
12543 C print *,"I am in true lipid"
12549 endif ! if in lipid or buffor
12550 CEND OF FINITE FRAGMENT
12551 C as the tube is infinity we do not calculate the Z-vector use of Z
12554 C now calculte the distance
12555 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12556 C now normalize vector
12557 vectube(1)=vectube(1)/tub_r
12558 vectube(2)=vectube(2)/tub_r
12559 C calculte rdiffrence between r and r0
12562 rdiff6=rdiff**6.0d0
12563 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12564 sc_aa_tube=sc_aa_tube_par(iti)
12565 sc_bb_tube=sc_bb_tube_par(iti)
12566 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)
12567 & *sstube+enetube(i+nres)
12568 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12569 C now we calculate gradient
12570 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
12571 & 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
12572 C now direction of gg_tube vector
12574 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
12575 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
12577 gg_tube_SC(3,i)=gg_tube_SC(3,i)
12578 &+ssgradtube*enetube(i+nres)/sstube
12579 gg_tube(3,i-1)= gg_tube(3,i-1)
12580 &+ssgradtube*enetube(i+nres)/sstube
12583 do i=itube_start,itube_end
12584 Etube=Etube+enetube(i)+enetube(i+nres)
12586 C print *,"ETUBE", etube
12589 C TO DO 1) add to total energy
12590 C 2) add to gradient summation
12591 C 3) add reading parameters (AND of course oppening of PARAM file)
12592 C 4) add reading the center of tube
12594 C 6) add to zerograd
12597 C#-------------------------------------------------------------------------------
12598 C This subroutine is to mimic the histone like structure but as well can be
12599 C utilizet to nanostructures (infinit) small modification has to be used to
12600 C make it finite (z gradient at the ends has to be changes as well as the x,y
12601 C gradient has to be modified at the ends
12602 C The energy function is Kihara potential
12603 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
12604 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
12605 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
12606 C simple Kihara potential
12607 subroutine calcnano(Etube)
12608 implicit real*8 (a-h,o-z)
12609 include 'DIMENSIONS'
12610 include 'COMMON.GEO'
12611 include 'COMMON.VAR'
12612 include 'COMMON.LOCAL'
12613 include 'COMMON.CHAIN'
12614 include 'COMMON.DERIV'
12615 include 'COMMON.NAMES'
12616 include 'COMMON.INTERACT'
12617 include 'COMMON.IOUNITS'
12618 include 'COMMON.CALC'
12619 include 'COMMON.CONTROL'
12620 include 'COMMON.SPLITELE'
12621 include 'COMMON.SBRIDGE'
12622 double precision tub_r,vectube(3),enetube(maxres*2),
12623 & enecavtube(maxres*2)
12625 do i=itube_start,itube_end
12627 enetube(i+nres)=0.0d0
12629 C first we calculate the distance from tube center
12630 C first sugare-phosphate group for NARES this would be peptide group
12632 do i=itube_start,itube_end
12633 C lets ommit dummy atoms for now
12634 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
12635 C now calculate distance from center of tube and direction vectors
12641 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
12642 vectube(1)=vectube(1)+boxxsize*j
12643 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
12644 vectube(2)=vectube(2)+boxysize*j
12645 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
12646 vectube(3)=vectube(3)+boxzsize*j
12649 xminact=dabs(vectube(1)-tubecenter(1))
12650 yminact=dabs(vectube(2)-tubecenter(2))
12651 zminact=dabs(vectube(3)-tubecenter(3))
12653 if (xmin.gt.xminact) then
12657 if (ymin.gt.yminact) then
12661 if (zmin.gt.zminact) then
12670 vectube(1)=vectube(1)-tubecenter(1)
12671 vectube(2)=vectube(2)-tubecenter(2)
12672 vectube(3)=vectube(3)-tubecenter(3)
12674 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
12675 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
12676 C as the tube is infinity we do not calculate the Z-vector use of Z
12679 C now calculte the distance
12680 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12681 C now normalize vector
12682 vectube(1)=vectube(1)/tub_r
12683 vectube(2)=vectube(2)/tub_r
12684 vectube(3)=vectube(3)/tub_r
12685 C calculte rdiffrence between r and r0
12688 rdiff6=rdiff**6.0d0
12689 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12690 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
12691 C write(iout,*) "TU13",i,rdiff6,enetube(i)
12692 C print *,rdiff,rdiff6,pep_aa_tube
12693 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12694 C now we calculate gradient
12695 fac=(-12.0d0*pep_aa_tube/rdiff6-
12696 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
12697 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
12699 if (acavtubpep.eq.0.0d0) then
12704 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
12706 & (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep)
12709 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff))
12710 & *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)
12711 & +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0)
12712 & /denominator**2.0d0
12717 C print *,"TUT",i,iti,rdiff,rdiff6,acavtubpep,denominator,
12718 C & enecavtube(i),faccav
12720 C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
12721 CX print *,"finene=",enetube(i+nres)+enecavtube(i)
12723 C now direction of gg_tube vector
12725 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
12726 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
12730 do i=itube_start,itube_end
12731 enecavtube(i)=0.0d0
12732 C Lets not jump over memory as we use many times iti
12734 C lets ommit dummy atoms for now
12736 C in UNRES uncomment the line below as GLY has no side-chain...
12743 vectube(1)=dmod((c(1,i+nres)),boxxsize)
12744 vectube(1)=vectube(1)+boxxsize*j
12745 vectube(2)=dmod((c(2,i+nres)),boxysize)
12746 vectube(2)=vectube(2)+boxysize*j
12747 vectube(3)=dmod((c(3,i+nres)),boxzsize)
12748 vectube(3)=vectube(3)+boxzsize*j
12751 xminact=dabs(vectube(1)-tubecenter(1))
12752 yminact=dabs(vectube(2)-tubecenter(2))
12753 zminact=dabs(vectube(3)-tubecenter(3))
12755 if (xmin.gt.xminact) then
12759 if (ymin.gt.yminact) then
12763 if (zmin.gt.zminact) then
12772 C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
12774 vectube(1)=vectube(1)-tubecenter(1)
12775 vectube(2)=vectube(2)-tubecenter(2)
12776 vectube(3)=vectube(3)-tubecenter(3)
12777 C now calculte the distance
12778 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12779 C now normalize vector
12780 vectube(1)=vectube(1)/tub_r
12781 vectube(2)=vectube(2)/tub_r
12782 vectube(3)=vectube(3)/tub_r
12784 C calculte rdiffrence between r and r0
12787 rdiff6=rdiff**6.0d0
12788 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12789 sc_aa_tube=sc_aa_tube_par(iti)
12790 sc_bb_tube=sc_bb_tube_par(iti)
12791 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
12792 C enetube(i+nres)=0.0d0
12793 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12794 C now we calculate gradient
12795 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
12796 & 6.0d0*sc_bb_tube/rdiff6/rdiff
12798 C now direction of gg_tube vector
12799 C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
12800 if (acavtub(iti).eq.0.0d0) then
12802 enecavtube(i+nres)=0.0d0
12805 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
12806 enecavtube(i+nres)=
12807 & (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti))
12809 C enecavtube(i)=0.0
12810 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff))
12811 & *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)
12812 & +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0)
12813 & /denominator**2.0d0
12818 C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
12819 C & enecavtube(i),faccav
12821 C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
12822 C print *,"finene=",enetube(i+nres)+enecavtube(i)
12824 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
12825 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
12828 C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
12829 C do i=itube_start,itube_end
12832 C if (acavtub(iti).eq.0.0) cycle
12836 do i=itube_start,itube_end
12837 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i)
12838 & +enecavtube(i+nres)
12840 C print *,"ETUBE", etube
12843 C TO DO 1) add to total energy
12844 C 2) add to gradient summation
12845 C 3) add reading parameters (AND of course oppening of PARAM file)
12846 C 4) add reading the center of tube
12848 C 6) add to zerograd