1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 integer status(MPI_STATUS_SIZE)
16 include 'COMMON.SETUP'
17 include 'COMMON.IOUNITS'
18 double precision energia(0:n_ene)
19 include 'COMMON.LOCAL'
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
27 include 'COMMON.CONTROL'
28 include 'COMMON.TIME1'
29 include 'COMMON.SPLITELE'
30 include 'COMMON.SHIELD'
31 double precision fac_shieldbuf(maxres),
32 & grad_shield_locbuf(3,maxcontsshi,-1:maxres),
33 & grad_shield_sidebuf(3,maxcontsshi,-1:maxres),
34 & grad_shieldbuf(3,-1:maxres)
35 integer ishield_listbuf(maxres),
36 &shield_listbuf(maxcontsshi,maxres)
38 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
39 c & " nfgtasks",nfgtasks
40 if (nfgtasks.gt.1) then
42 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
43 if (fg_rank.eq.0) then
44 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
45 c print *,"Processor",myrank," BROADCAST iorder"
46 C FG master sets up the WEIGHTS_ array which will be broadcast to the
47 C FG slaves as WEIGHTS array.
69 C FG Master broadcasts the WEIGHTS_ array
70 call MPI_Bcast(weights_(1),n_ene,
71 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
73 C FG slaves receive the WEIGHTS array
74 call MPI_Bcast(weights(1),n_ene,
75 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
97 time_Bcast=time_Bcast+MPI_Wtime()-time00
98 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
99 c call chainbuild_cart
101 c print *,'Processor',myrank,' calling etotal ipot=',ipot
102 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
104 c if (modecalc.eq.12.or.modecalc.eq.14) then
105 c call int_from_cart1(.false.)
112 C Compute the side-chain and electrostatic interaction energy
115 goto (101,102,103,104,105,106) ipot
116 C Lennard-Jones potential.
118 cd print '(a)','Exit ELJ'
120 C Lennard-Jones-Kihara potential (shifted).
123 C Berne-Pechukas potential (dilated LJ, angular dependence).
126 C Gay-Berne potential (shifted LJ, angular dependence).
128 C print *,"bylem w egb"
130 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
133 C Soft-sphere potential
134 106 call e_softsphere(evdw)
136 C Calculate electrostatic (H-bonding) energy of the main chain.
140 cmc Sep-06: egb takes care of dynamic ss bonds too
142 c if (dyn_ss) call dyn_set_nss
144 c print *,"Processor",myrank," computed USCSC"
150 time_vec=time_vec+MPI_Wtime()-time01
152 C Introduction of shielding effect first for each peptide group
153 C the shielding factor is set this factor is describing how each
154 C peptide group is shielded by side-chains
155 C the matrix - shield_fac(i) the i index describe the ith between i and i+1
156 C write (iout,*) "shield_mode",shield_mode
157 if (shield_mode.eq.1) then
159 else if (shield_mode.eq.2) then
161 if (nfgtasks.gt.1) then
164 write(iout,*) "befor reduce fac_shield reduce"
166 write(2,*) "fac",itype(i),fac_shield(i),grad_shield(1,i)
167 write(2,*) "list", shield_list(1,i),ishield_list(i),
168 & grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
171 call MPI_Allgatherv(fac_shield(ivec_start),
172 & ivec_count(fg_rank1),
173 & MPI_DOUBLE_PRECISION,fac_shieldbuf(1),ivec_count(0),
175 & MPI_DOUBLE_PRECISION,FG_COMM,IERR)
176 call MPI_Allgatherv(shield_list(1,ivec_start),
177 & ivec_count(fg_rank1),
178 & MPI_I50,shield_listbuf(1,1),ivec_count(0),
180 & MPI_I50,FG_COMM,IERR)
181 call MPI_Allgatherv(ishield_list(ivec_start),
182 & ivec_count(fg_rank1),
183 & MPI_INTEGER,ishield_listbuf(1),ivec_count(0),
185 & MPI_INTEGER,FG_COMM,IERR)
186 call MPI_Allgatherv(grad_shield(1,ivec_start),
187 & ivec_count(fg_rank1),
188 & MPI_UYZ,grad_shieldbuf(1,1),ivec_count(0),
190 & MPI_UYZ,FG_COMM,IERR)
191 call MPI_Allgatherv(grad_shield_side(1,1,ivec_start),
192 & ivec_count(fg_rank1),
193 & MPI_SHI,grad_shield_sidebuf(1,1,1),ivec_count(0),
195 & MPI_SHI,FG_COMM,IERR)
196 call MPI_Allgatherv(grad_shield_loc(1,1,ivec_start),
197 & ivec_count(fg_rank1),
198 & MPI_SHI,grad_shield_locbuf(1,1,1),ivec_count(0),
200 & MPI_SHI,FG_COMM,IERR)
202 fac_shield(i)=fac_shieldbuf(i)
203 ishield_list(i)=ishield_listbuf(i)
205 grad_shield(j,i)=grad_shieldbuf(j,i)
207 do j=1,ishield_list(i)
208 shield_list(j,i)=shield_listbuf(j,i)
210 grad_shield_loc(k,j,i)=grad_shield_locbuf(k,j,i)
211 grad_shield_side(k,j,i)=grad_shield_sidebuf(k,j,i)
216 write(iout,*) "after reduce fac_shield reduce"
218 write(2,*) "fac",itype(i),fac_shield(i),grad_shield(1,i)
219 write(2,*) "list", shield_list(1,i),ishield_list(i),
220 & grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
227 write(iout,*) fac_shield(i),ishield_list(i),i,grad_shield(1,i)
228 do j=1,ishield_list(i)
229 write(iout,*) "grad", grad_shield_side(1,j,i),
230 & grad_shield_loc(1,j,i)
235 c print *,"Processor",myrank," left VEC_AND_DERIV"
238 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
239 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
240 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
241 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
243 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
244 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
245 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
246 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
248 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
257 write (iout,*) "Soft-spheer ELEC potential"
258 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
261 c print *,"Processor",myrank," computed UELEC"
263 C Calculate excluded-volume interaction energy between peptide groups
268 call escp(evdw2,evdw2_14)
274 c write (iout,*) "Soft-sphere SCP potential"
275 call escp_soft_sphere(evdw2,evdw2_14)
278 c Calculate the bond-stretching energy
282 C Calculate the disulfide-bridge and other energy and the contributions
283 C from other distance constraints.
284 cd print *,'Calling EHPB'
286 cd print *,'EHPB exitted succesfully.'
288 C Calculate the virtual-bond-angle energy.
290 if (wang.gt.0d0) then
291 if ((tor_mode.eq.0).or.(tor_mode.eq.2)) then
292 call ebend(ebe,ethetacnstr)
294 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
296 if ((tor_mode.eq.1).or.(tor_mode.eq.2)) then
297 call ebend_kcc(ebe,ethetacnstr)
303 c print *,"Processor",myrank," computed UB"
305 C Calculate the SC local energy.
307 C print *,"TU DOCHODZE?"
309 c print *,"Processor",myrank," computed USC"
311 C Calculate the virtual-bond torsional energy.
313 cd print *,'nterm=',nterm
314 C print *,"tor",tor_mode
316 if ((tor_mode.eq.0).or.(tor_mode.eq.2)) then
317 call etor(etors,edihcnstr)
319 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
321 if ((tor_mode.eq.1).or.(tor_mode.eq.2)) then
322 call etor_kcc(etors,edihcnstr)
328 c print *,"Processor",myrank," computed Utor"
330 C 6/23/01 Calculate double-torsional energy
332 if ((wtor_d.gt.0).and.((tor_mode.eq.0).or.(tor_mode.eq.2))) then
337 c print *,"Processor",myrank," computed Utord"
339 C 21/5/07 Calculate local sicdechain correlation energy
341 if (wsccor.gt.0.0d0) then
342 call eback_sc_corr(esccor)
346 C print *,"PRZED MULIt"
347 c print *,"Processor",myrank," computed Usccorr"
349 C 12/1/95 Multi-body terms
353 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
354 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
355 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
356 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
357 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
364 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
365 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
366 cd write (iout,*) "multibody_hb ecorr",ecorr
368 c print *,"Processor",myrank," computed Ucorr"
370 C If performing constraint dynamics, call the constraint energy
371 C after the equilibration time
372 if(usampl.and.totT.gt.eq_time) then
379 C 01/27/2015 added by adasko
380 C the energy component below is energy transfer into lipid environment
381 C based on partition function
382 C print *,"przed lipidami"
383 if (wliptran.gt.0) then
384 call Eliptransfer(eliptran)
388 C print *,"za lipidami"
389 if (AFMlog.gt.0) then
390 call AFMforce(Eafmforce)
391 else if (selfguide.gt.0) then
392 call AFMvel(Eafmforce)
394 if (TUBElog.eq.1) then
395 C print *,"just before call"
397 elseif (TUBElog.eq.2) then
398 call calctube2(Etube)
399 elseif (TUBElog.eq.3) then
406 time_enecalc=time_enecalc+MPI_Wtime()-time00
408 c print *,"Processor",myrank," computed Uconstr"
417 energia(2)=evdw2-evdw2_14
434 energia(8)=eello_turn3
435 energia(9)=eello_turn4
442 energia(19)=edihcnstr
444 energia(20)=Uconst+Uconst_back
447 energia(23)=Eafmforce
448 energia(24)=ethetacnstr
450 c Here are the energies showed per procesor if the are more processors
451 c per molecule then we sum it up in sum_energy subroutine
452 c print *," Processor",myrank," calls SUM_ENERGY"
453 call sum_energy(energia,.true.)
454 if (dyn_ss) call dyn_set_nss
455 c print *," Processor",myrank," left SUM_ENERGY"
457 time_sumene=time_sumene+MPI_Wtime()-time00
461 c-------------------------------------------------------------------------------
462 subroutine sum_energy(energia,reduce)
463 implicit real*8 (a-h,o-z)
468 cMS$ATTRIBUTES C :: proc_proc
474 include 'COMMON.SETUP'
475 include 'COMMON.IOUNITS'
476 double precision energia(0:n_ene),enebuff(0:n_ene+1)
477 include 'COMMON.FFIELD'
478 include 'COMMON.DERIV'
479 include 'COMMON.INTERACT'
480 include 'COMMON.SBRIDGE'
481 include 'COMMON.CHAIN'
483 include 'COMMON.CONTROL'
484 include 'COMMON.TIME1'
487 if (nfgtasks.gt.1 .and. reduce) then
489 write (iout,*) "energies before REDUCE"
490 call enerprint(energia)
494 enebuff(i)=energia(i)
497 call MPI_Barrier(FG_COMM,IERR)
498 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
500 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
501 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
503 write (iout,*) "energies after REDUCE"
504 call enerprint(energia)
507 time_Reduce=time_Reduce+MPI_Wtime()-time00
509 if (fg_rank.eq.0) then
513 evdw2=energia(2)+energia(18)
529 eello_turn3=energia(8)
530 eello_turn4=energia(9)
537 edihcnstr=energia(19)
542 Eafmforce=energia(23)
543 ethetacnstr=energia(24)
546 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
547 & +wang*ebe+wtor*etors+wscloc*escloc
548 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
549 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
550 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
551 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+Eafmforce
552 & +ethetacnstr+wtube*Etube
554 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
555 & +wang*ebe+wtor*etors+wscloc*escloc
556 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
557 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
558 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
559 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
561 & +ethetacnstr+wtube*Etube
567 if (isnan(etot).ne.0) energia(0)=1.0d+99
569 if (isnan(etot)) energia(0)=1.0d+99
574 idumm=proc_proc(etot,i)
576 call proc_proc(etot,i)
578 if(i.eq.1)energia(0)=1.0d+99
585 c-------------------------------------------------------------------------------
586 subroutine sum_gradient
587 implicit real*8 (a-h,o-z)
592 cMS$ATTRIBUTES C :: proc_proc
598 double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
599 & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
600 & ,gloc_scbuf(3,-1:maxres)
601 include 'COMMON.SETUP'
602 include 'COMMON.IOUNITS'
603 include 'COMMON.FFIELD'
604 include 'COMMON.DERIV'
605 include 'COMMON.INTERACT'
606 include 'COMMON.SBRIDGE'
607 include 'COMMON.CHAIN'
609 include 'COMMON.CONTROL'
610 include 'COMMON.TIME1'
611 include 'COMMON.MAXGRAD'
612 include 'COMMON.SCCOR'
617 write (iout,*) "sum_gradient gvdwc, gvdwx"
619 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
620 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
625 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
626 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
627 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
630 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
631 C in virtual-bond-vector coordinates
634 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
636 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
637 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
639 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
641 c write (iout,'(i5,3f10.5,2x,f10.5)')
642 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
644 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
646 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
647 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
655 gradbufc(j,i)=wsc*gvdwc(j,i)+
656 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
657 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
658 & wel_loc*gel_loc_long(j,i)+
659 & wcorr*gradcorr_long(j,i)+
660 & wcorr5*gradcorr5_long(j,i)+
661 & wcorr6*gradcorr6_long(j,i)+
662 & wturn6*gcorr6_turn_long(j,i)+
664 & +wliptran*gliptranc(j,i)
666 & +welec*gshieldc(j,i)
667 & +wcorr*gshieldc_ec(j,i)
668 & +wturn3*gshieldc_t3(j,i)
669 & +wturn4*gshieldc_t4(j,i)
670 & +wel_loc*gshieldc_ll(j,i)
671 & +wtube*gg_tube(j,i)
679 C print *,"KUPA2",gradbufc(j,i),wsc*gvdwc(j,i),
680 C & wscp*gvdwc_scp(j,i),gvdwc_scpp(j,i),
681 C & welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i),
682 C & wel_loc*gel_loc_long(j,i),
683 C & wcorr*gradcorr_long(j,i),
684 C & wcorr5*gradcorr5_long(j,i),
685 C & wcorr6*gradcorr6_long(j,i),
686 C & wturn6*gcorr6_turn_long(j,i),
687 C & wstrain*ghpbc(j,i)
688 C & ,wliptran*gliptranc(j,i)
690 C & ,welec*gshieldc(j,i)
691 C & ,wcorr*gshieldc_ec(j,i)
692 C & ,wturn3*gshieldc_t3(j,i)
693 C & ,wturn4*gshieldc_t4(j,i)
694 C & ,wel_loc*gshieldc_ll(j,i)
695 C & ,wtube*gg_tube(j,i)
699 gradbufc(j,i)=wsc*gvdwc(j,i)+
700 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
701 & welec*gelc_long(j,i)+
703 & wel_loc*gel_loc_long(j,i)+
704 & wcorr*gradcorr_long(j,i)+
705 & wcorr5*gradcorr5_long(j,i)+
706 & wcorr6*gradcorr6_long(j,i)+
707 & wturn6*gcorr6_turn_long(j,i)+
709 & +wliptran*gliptranc(j,i)
711 & +welec*gshieldc(j,i)
712 & +wcorr*gshieldc_ec(j,i)
713 & +wturn4*gshieldc_t4(j,i)
714 & +wel_loc*gshieldc_ll(j,i)
715 & +wtube*gg_tube(j,i)
723 if (nfgtasks.gt.1) then
726 write (iout,*) "gradbufc before allreduce"
728 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
734 gradbufc_sum(j,i)=gradbufc(j,i)
737 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
738 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
739 c time_reduce=time_reduce+MPI_Wtime()-time00
741 c write (iout,*) "gradbufc_sum after allreduce"
743 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
748 c time_allreduce=time_allreduce+MPI_Wtime()-time00
756 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
757 write (iout,*) (i," jgrad_start",jgrad_start(i),
758 & " jgrad_end ",jgrad_end(i),
759 & i=igrad_start,igrad_end)
762 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
763 c do not parallelize this part.
765 c do i=igrad_start,igrad_end
766 c do j=jgrad_start(i),jgrad_end(i)
768 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
773 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
777 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
781 write (iout,*) "gradbufc after summing"
783 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
790 write (iout,*) "gradbufc"
792 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
798 gradbufc_sum(j,i)=gradbufc(j,i)
803 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
807 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
812 c gradbufc(k,i)=0.0d0
816 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
821 write (iout,*) "gradbufc after summing"
823 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
831 gradbufc(k,nres)=0.0d0
836 C print *,gradbufc(1,13)
837 C print *,welec*gelc(1,13)
838 C print *,wel_loc*gel_loc(1,13)
839 C print *,0.5d0*(wscp*gvdwc_scpp(1,13))
840 C print *,welec*gelc_long(1,13)+wvdwpp*gvdwpp(1,13)
841 C print *,wel_loc*gel_loc_long(1,13)
842 C print *,gradafm(1,13),"AFM"
843 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
844 & wel_loc*gel_loc(j,i)+
845 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
846 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
847 & wel_loc*gel_loc_long(j,i)+
848 & wcorr*gradcorr_long(j,i)+
849 & wcorr5*gradcorr5_long(j,i)+
850 & wcorr6*gradcorr6_long(j,i)+
851 & wturn6*gcorr6_turn_long(j,i))+
853 & wcorr*gradcorr(j,i)+
854 & wturn3*gcorr3_turn(j,i)+
855 & wturn4*gcorr4_turn(j,i)+
856 & wcorr5*gradcorr5(j,i)+
857 & wcorr6*gradcorr6(j,i)+
858 & wturn6*gcorr6_turn(j,i)+
859 & wsccor*gsccorc(j,i)
860 & +wscloc*gscloc(j,i)
861 & +wliptran*gliptranc(j,i)
863 & +welec*gshieldc(j,i)
864 & +welec*gshieldc_loc(j,i)
865 & +wcorr*gshieldc_ec(j,i)
866 & +wcorr*gshieldc_loc_ec(j,i)
867 & +wturn3*gshieldc_t3(j,i)
868 & +wturn3*gshieldc_loc_t3(j,i)
869 & +wturn4*gshieldc_t4(j,i)
870 & +wturn4*gshieldc_loc_t4(j,i)
871 & +wel_loc*gshieldc_ll(j,i)
872 & +wel_loc*gshieldc_loc_ll(j,i)
873 & +wtube*gg_tube(j,i)
876 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
877 & wel_loc*gel_loc(j,i)+
878 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
879 & welec*gelc_long(j,i)+
880 & wel_loc*gel_loc_long(j,i)+
881 & wcorr*gcorr_long(j,i)+
882 & wcorr5*gradcorr5_long(j,i)+
883 & wcorr6*gradcorr6_long(j,i)+
884 & wturn6*gcorr6_turn_long(j,i))+
886 & wcorr*gradcorr(j,i)+
887 & wturn3*gcorr3_turn(j,i)+
888 & wturn4*gcorr4_turn(j,i)+
889 & wcorr5*gradcorr5(j,i)+
890 & wcorr6*gradcorr6(j,i)+
891 & wturn6*gcorr6_turn(j,i)+
892 & wsccor*gsccorc(j,i)
893 & +wscloc*gscloc(j,i)
894 & +wliptran*gliptranc(j,i)
896 & +welec*gshieldc(j,i)
897 & +welec*gshieldc_loc(j,i)
898 & +wcorr*gshieldc_ec(j,i)
899 & +wcorr*gshieldc_loc_ec(j,i)
900 & +wturn3*gshieldc_t3(j,i)
901 & +wturn3*gshieldc_loc_t3(j,i)
902 & +wturn4*gshieldc_t4(j,i)
903 & +wturn4*gshieldc_loc_t4(j,i)
904 & +wel_loc*gshieldc_ll(j,i)
905 & +wel_loc*gshieldc_loc_ll(j,i)
906 & +wtube*gg_tube(j,i)
910 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
912 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
913 & wsccor*gsccorx(j,i)
914 & +wscloc*gsclocx(j,i)
915 & +wliptran*gliptranx(j,i)
916 & +welec*gshieldx(j,i)
917 & +wcorr*gshieldx_ec(j,i)
918 & +wturn3*gshieldx_t3(j,i)
919 & +wturn4*gshieldx_t4(j,i)
920 & +wel_loc*gshieldx_ll(j,i)
921 & +wtube*gg_tube_sc(j,i)
929 C print *,"KUPA", gradbufc(j,i),welec*gelc(j,i),
930 C & wel_loc*gel_loc(j,i),
931 C & 0.5d0*wscp*gvdwc_scpp(j,i),
932 C & welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i),
933 C & wel_loc*gel_loc_long(j,i),
934 C & wcorr*gradcorr_long(j,i),
935 C & wcorr5*gradcorr5_long(j,i),
936 C & wcorr6*gradcorr6_long(j,i),
937 C & wturn6*gcorr6_turn_long(j,i),
938 C & wbond*gradb(j,i),
939 C & wcorr*gradcorr(j,i),
940 C & wturn3*gcorr3_turn(j,i),
941 C & wturn4*gcorr4_turn(j,i),
942 C & wcorr5*gradcorr5(j,i),
943 C & wcorr6*gradcorr6(j,i),
944 C & wturn6*gcorr6_turn(j,i),
945 C & wsccor*gsccorc(j,i)
946 C & ,wscloc*gscloc(j,i)
947 C & ,wliptran*gliptranc(j,i)
949 C & +welec*gshieldc(j,i)
950 C & +welec*gshieldc_loc(j,i)
951 C & +wcorr*gshieldc_ec(j,i)
952 C & +wcorr*gshieldc_loc_ec(j,i)
953 C & +wturn3*gshieldc_t3(j,i)
954 C & +wturn3*gshieldc_loc_t3(j,i)
955 C & +wturn4*gshieldc_t4(j,i)
956 C & ,wturn4*gshieldc_loc_t4(j,i)
957 C & ,wel_loc*gshieldc_ll(j,i)
958 C & ,wel_loc*gshieldc_loc_ll(j,i)
959 C & ,wtube*gg_tube(j,i)
961 C print *,gg_tube(1,0),"TU3"
963 write (iout,*) "gloc before adding corr"
965 write (iout,*) i,gloc(i,icg)
969 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
970 & +wcorr5*g_corr5_loc(i)
971 & +wcorr6*g_corr6_loc(i)
972 & +wturn4*gel_loc_turn4(i)
973 & +wturn3*gel_loc_turn3(i)
974 & +wturn6*gel_loc_turn6(i)
975 & +wel_loc*gel_loc_loc(i)
978 write (iout,*) "gloc after adding corr"
980 write (iout,*) i,gloc(i,icg)
984 if (nfgtasks.gt.1) then
987 gradbufc(j,i)=gradc(j,i,icg)
988 gradbufx(j,i)=gradx(j,i,icg)
992 glocbuf(i)=gloc(i,icg)
996 write (iout,*) "gloc_sc before reduce"
999 write (iout,*) i,j,gloc_sc(j,i,icg)
1006 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
1010 call MPI_Barrier(FG_COMM,IERR)
1011 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
1013 call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,
1014 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
1015 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
1016 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
1017 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
1018 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
1019 time_reduce=time_reduce+MPI_Wtime()-time00
1020 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
1021 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
1022 time_reduce=time_reduce+MPI_Wtime()-time00
1025 write (iout,*) "gloc_sc after reduce"
1028 write (iout,*) i,j,gloc_sc(j,i,icg)
1034 write (iout,*) "gloc after reduce"
1036 write (iout,*) i,gloc(i,icg)
1041 if (gnorm_check) then
1043 c Compute the maximum elements of the gradient
1053 gcorr3_turn_max=0.0d0
1054 gcorr4_turn_max=0.0d0
1057 gcorr6_turn_max=0.0d0
1067 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
1068 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
1069 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
1070 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
1071 & gvdwc_scp_max=gvdwc_scp_norm
1072 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
1073 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
1074 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
1075 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
1076 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
1077 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
1078 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
1079 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
1080 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
1081 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
1082 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
1083 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
1084 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
1085 & gcorr3_turn(1,i)))
1086 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
1087 & gcorr3_turn_max=gcorr3_turn_norm
1088 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
1089 & gcorr4_turn(1,i)))
1090 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
1091 & gcorr4_turn_max=gcorr4_turn_norm
1092 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
1093 if (gradcorr5_norm.gt.gradcorr5_max)
1094 & gradcorr5_max=gradcorr5_norm
1095 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
1096 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
1097 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
1098 & gcorr6_turn(1,i)))
1099 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
1100 & gcorr6_turn_max=gcorr6_turn_norm
1101 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
1102 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
1103 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
1104 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
1105 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
1106 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
1107 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
1108 if (gradx_scp_norm.gt.gradx_scp_max)
1109 & gradx_scp_max=gradx_scp_norm
1110 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
1111 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
1112 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
1113 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
1114 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
1115 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
1116 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
1117 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
1121 open(istat,file=statname,position="append")
1123 open(istat,file=statname,access="append")
1125 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
1126 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
1127 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
1128 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
1129 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
1130 & gsccorx_max,gsclocx_max
1132 if (gvdwc_max.gt.1.0d4) then
1133 write (iout,*) "gvdwc gvdwx gradb gradbx"
1135 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
1136 & gradb(j,i),gradbx(j,i),j=1,3)
1138 call pdbout(0.0d0,'cipiszcze',iout)
1144 write (iout,*) "gradc gradx gloc"
1146 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
1147 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
1151 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
1155 c-------------------------------------------------------------------------------
1156 subroutine rescale_weights(t_bath)
1157 implicit real*8 (a-h,o-z)
1158 include 'DIMENSIONS'
1159 include 'COMMON.IOUNITS'
1160 include 'COMMON.FFIELD'
1161 include 'COMMON.SBRIDGE'
1162 include 'COMMON.CONTROL'
1163 double precision kfac /2.4d0/
1164 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
1166 c facT=2*temp0/(t_bath+temp0)
1167 if (rescale_mode.eq.0) then
1173 else if (rescale_mode.eq.1) then
1174 facT=kfac/(kfac-1.0d0+t_bath/temp0)
1175 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1176 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1177 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1178 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1179 else if (rescale_mode.eq.2) then
1185 facT=licznik/dlog(dexp(x)+dexp(-x))
1186 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
1187 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
1188 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
1189 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
1191 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1192 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1194 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1198 if (shield_mode.gt.0) then
1199 wscp=weights(2)*fact
1201 wvdwpp=weights(16)*fact
1203 welec=weights(3)*fact
1204 wcorr=weights(4)*fact3
1205 wcorr5=weights(5)*fact4
1206 wcorr6=weights(6)*fact5
1207 wel_loc=weights(7)*fact2
1208 wturn3=weights(8)*fact2
1209 wturn4=weights(9)*fact3
1210 wturn6=weights(10)*fact5
1211 wtor=weights(13)*fact
1212 wtor_d=weights(14)*fact2
1213 wsccor=weights(21)*fact
1217 C------------------------------------------------------------------------
1218 subroutine enerprint(energia)
1219 implicit real*8 (a-h,o-z)
1220 include 'DIMENSIONS'
1221 include 'COMMON.IOUNITS'
1222 include 'COMMON.FFIELD'
1223 include 'COMMON.SBRIDGE'
1225 double precision energia(0:n_ene)
1230 evdw2=energia(2)+energia(18)
1242 eello_turn3=energia(8)
1243 eello_turn4=energia(9)
1244 eello_turn6=energia(10)
1250 edihcnstr=energia(19)
1254 eliptran=energia(22)
1255 Eafmforce=energia(23)
1256 ethetacnstr=energia(24)
1259 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1260 & estr,wbond,ebe,wang,
1261 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1263 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1264 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,
1265 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1268 10 format (/'Virtual-chain energies:'//
1269 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1270 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1271 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1272 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1273 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1274 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1275 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1276 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1277 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1278 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1279 & ' (SS bridges & dist. cnstr.)'/
1280 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1281 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1282 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1283 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1284 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1285 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1286 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1287 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1288 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1289 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1290 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1291 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1292 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1293 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1294 & 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/
1295 & 'ETOT= ',1pE16.6,' (total)')
1298 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1299 & estr,wbond,ebe,wang,
1300 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1302 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1303 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1304 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1307 10 format (/'Virtual-chain energies:'//
1308 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1309 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1310 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1311 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1312 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1313 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1314 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1315 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1316 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1317 & ' (SS bridges & dist. cnstr.)'/
1318 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1319 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1320 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1321 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1322 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1323 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1324 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1325 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1326 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1327 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1328 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1329 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1330 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1331 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1332 & 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/
1333 & 'ETOT= ',1pE16.6,' (total)')
1337 C-----------------------------------------------------------------------
1338 subroutine elj(evdw)
1340 C This subroutine calculates the interaction energy of nonbonded side chains
1341 C assuming the LJ potential of interaction.
1343 implicit real*8 (a-h,o-z)
1344 include 'DIMENSIONS'
1345 parameter (accur=1.0d-10)
1346 include 'COMMON.GEO'
1347 include 'COMMON.VAR'
1348 include 'COMMON.LOCAL'
1349 include 'COMMON.CHAIN'
1350 include 'COMMON.DERIV'
1351 include 'COMMON.INTERACT'
1352 include 'COMMON.TORSION'
1353 include 'COMMON.SBRIDGE'
1354 include 'COMMON.NAMES'
1355 include 'COMMON.IOUNITS'
1356 include 'COMMON.CONTACTS'
1358 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1360 do i=iatsc_s,iatsc_e
1361 itypi=iabs(itype(i))
1362 if (itypi.eq.ntyp1) cycle
1363 itypi1=iabs(itype(i+1))
1370 C Calculate SC interaction energy.
1372 do iint=1,nint_gr(i)
1373 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1374 cd & 'iend=',iend(i,iint)
1375 do j=istart(i,iint),iend(i,iint)
1376 itypj=iabs(itype(j))
1377 if (itypj.eq.ntyp1) cycle
1381 C Change 12/1/95 to calculate four-body interactions
1382 rij=xj*xj+yj*yj+zj*zj
1384 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1385 eps0ij=eps(itypi,itypj)
1387 C have you changed here?
1391 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1392 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1393 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1394 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1395 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1396 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1399 C Calculate the components of the gradient in DC and X
1401 fac=-rrij*(e1+evdwij)
1406 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1407 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1408 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1409 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1413 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1417 C 12/1/95, revised on 5/20/97
1419 C Calculate the contact function. The ith column of the array JCONT will
1420 C contain the numbers of atoms that make contacts with the atom I (of numbers
1421 C greater than I). The arrays FACONT and GACONT will contain the values of
1422 C the contact function and its derivative.
1424 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1425 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1426 C Uncomment next line, if the correlation interactions are contact function only
1427 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1429 sigij=sigma(itypi,itypj)
1430 r0ij=rs0(itypi,itypj)
1432 C Check whether the SC's are not too far to make a contact.
1435 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1436 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1438 if (fcont.gt.0.0D0) then
1439 C If the SC-SC distance if close to sigma, apply spline.
1440 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1441 cAdam & fcont1,fprimcont1)
1442 cAdam fcont1=1.0d0-fcont1
1443 cAdam if (fcont1.gt.0.0d0) then
1444 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1445 cAdam fcont=fcont*fcont1
1447 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1448 cga eps0ij=1.0d0/dsqrt(eps0ij)
1450 cga gg(k)=gg(k)*eps0ij
1452 cga eps0ij=-evdwij*eps0ij
1453 C Uncomment for AL's type of SC correlation interactions.
1454 cadam eps0ij=-evdwij
1455 num_conti=num_conti+1
1456 jcont(num_conti,i)=j
1457 facont(num_conti,i)=fcont*eps0ij
1458 fprimcont=eps0ij*fprimcont/rij
1460 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1461 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1462 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1463 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1464 gacont(1,num_conti,i)=-fprimcont*xj
1465 gacont(2,num_conti,i)=-fprimcont*yj
1466 gacont(3,num_conti,i)=-fprimcont*zj
1467 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1468 cd write (iout,'(2i3,3f10.5)')
1469 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1475 num_cont(i)=num_conti
1479 gvdwc(j,i)=expon*gvdwc(j,i)
1480 gvdwx(j,i)=expon*gvdwx(j,i)
1483 C******************************************************************************
1487 C To save time, the factor of EXPON has been extracted from ALL components
1488 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1491 C******************************************************************************
1494 C-----------------------------------------------------------------------------
1495 subroutine eljk(evdw)
1497 C This subroutine calculates the interaction energy of nonbonded side chains
1498 C assuming the LJK potential of interaction.
1500 implicit real*8 (a-h,o-z)
1501 include 'DIMENSIONS'
1502 include 'COMMON.GEO'
1503 include 'COMMON.VAR'
1504 include 'COMMON.LOCAL'
1505 include 'COMMON.CHAIN'
1506 include 'COMMON.DERIV'
1507 include 'COMMON.INTERACT'
1508 include 'COMMON.IOUNITS'
1509 include 'COMMON.NAMES'
1512 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1514 do i=iatsc_s,iatsc_e
1515 itypi=iabs(itype(i))
1516 if (itypi.eq.ntyp1) cycle
1517 itypi1=iabs(itype(i+1))
1522 C Calculate SC interaction energy.
1524 do iint=1,nint_gr(i)
1525 do j=istart(i,iint),iend(i,iint)
1526 itypj=iabs(itype(j))
1527 if (itypj.eq.ntyp1) cycle
1531 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1532 fac_augm=rrij**expon
1533 e_augm=augm(itypi,itypj)*fac_augm
1534 r_inv_ij=dsqrt(rrij)
1536 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1537 fac=r_shift_inv**expon
1538 C have you changed here?
1542 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1543 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1544 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1545 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1546 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1547 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1548 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1551 C Calculate the components of the gradient in DC and X
1553 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1558 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1559 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1560 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1561 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1565 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1573 gvdwc(j,i)=expon*gvdwc(j,i)
1574 gvdwx(j,i)=expon*gvdwx(j,i)
1579 C-----------------------------------------------------------------------------
1580 subroutine ebp(evdw)
1582 C This subroutine calculates the interaction energy of nonbonded side chains
1583 C assuming the Berne-Pechukas potential of interaction.
1585 implicit real*8 (a-h,o-z)
1586 include 'DIMENSIONS'
1587 include 'COMMON.GEO'
1588 include 'COMMON.VAR'
1589 include 'COMMON.LOCAL'
1590 include 'COMMON.CHAIN'
1591 include 'COMMON.DERIV'
1592 include 'COMMON.NAMES'
1593 include 'COMMON.INTERACT'
1594 include 'COMMON.IOUNITS'
1595 include 'COMMON.CALC'
1596 common /srutu/ icall
1597 c double precision rrsave(maxdim)
1600 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1602 c if (icall.eq.0) then
1608 do i=iatsc_s,iatsc_e
1609 itypi=iabs(itype(i))
1610 if (itypi.eq.ntyp1) cycle
1611 itypi1=iabs(itype(i+1))
1615 dxi=dc_norm(1,nres+i)
1616 dyi=dc_norm(2,nres+i)
1617 dzi=dc_norm(3,nres+i)
1618 c dsci_inv=dsc_inv(itypi)
1619 dsci_inv=vbld_inv(i+nres)
1621 C Calculate SC interaction energy.
1623 do iint=1,nint_gr(i)
1624 do j=istart(i,iint),iend(i,iint)
1626 itypj=iabs(itype(j))
1627 if (itypj.eq.ntyp1) cycle
1628 c dscj_inv=dsc_inv(itypj)
1629 dscj_inv=vbld_inv(j+nres)
1630 chi1=chi(itypi,itypj)
1631 chi2=chi(itypj,itypi)
1638 alf12=0.5D0*(alf1+alf2)
1639 C For diagnostics only!!!
1652 dxj=dc_norm(1,nres+j)
1653 dyj=dc_norm(2,nres+j)
1654 dzj=dc_norm(3,nres+j)
1655 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1656 cd if (icall.eq.0) then
1662 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1664 C Calculate whole angle-dependent part of epsilon and contributions
1665 C to its derivatives
1666 C have you changed here?
1667 fac=(rrij*sigsq)**expon2
1670 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1671 eps2der=evdwij*eps3rt
1672 eps3der=evdwij*eps2rt
1673 evdwij=evdwij*eps2rt*eps3rt
1676 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1678 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1679 cd & restyp(itypi),i,restyp(itypj),j,
1680 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1681 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1682 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1685 C Calculate gradient components.
1686 e1=e1*eps1*eps2rt**2*eps3rt**2
1687 fac=-expon*(e1+evdwij)
1690 C Calculate radial part of the gradient
1694 C Calculate the angular part of the gradient and sum add the contributions
1695 C to the appropriate components of the Cartesian gradient.
1703 C-----------------------------------------------------------------------------
1704 subroutine egb(evdw)
1706 C This subroutine calculates the interaction energy of nonbonded side chains
1707 C assuming the Gay-Berne potential of interaction.
1709 implicit real*8 (a-h,o-z)
1710 include 'DIMENSIONS'
1711 include 'COMMON.GEO'
1712 include 'COMMON.VAR'
1713 include 'COMMON.LOCAL'
1714 include 'COMMON.CHAIN'
1715 include 'COMMON.DERIV'
1716 include 'COMMON.NAMES'
1717 include 'COMMON.INTERACT'
1718 include 'COMMON.IOUNITS'
1719 include 'COMMON.CALC'
1720 include 'COMMON.CONTROL'
1721 include 'COMMON.SPLITELE'
1722 include 'COMMON.SBRIDGE'
1724 integer xshift,yshift,zshift
1727 ccccc energy_dec=.false.
1728 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1731 c if (icall.eq.0) lprn=.false.
1733 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1734 C we have the original box)
1738 do i=iatsc_s,iatsc_e
1739 itypi=iabs(itype(i))
1740 if (itypi.eq.ntyp1) cycle
1741 itypi1=iabs(itype(i+1))
1745 C Return atom into box, boxxsize is size of box in x dimension
1747 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1748 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1749 C Condition for being inside the proper box
1750 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1751 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1755 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1756 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1757 C Condition for being inside the proper box
1758 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1759 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1763 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1764 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1765 C Condition for being inside the proper box
1766 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1767 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1771 if (xi.lt.0) xi=xi+boxxsize
1773 if (yi.lt.0) yi=yi+boxysize
1775 if (zi.lt.0) zi=zi+boxzsize
1776 C define scaling factor for lipids
1778 C if (positi.le.0) positi=positi+boxzsize
1780 C first for peptide groups
1781 c for each residue check if it is in lipid or lipid water border area
1782 if ((zi.gt.bordlipbot)
1783 &.and.(zi.lt.bordliptop)) then
1784 C the energy transfer exist
1785 if (zi.lt.buflipbot) then
1786 C what fraction I am in
1788 & ((zi-bordlipbot)/lipbufthick)
1789 C lipbufthick is thickenes of lipid buffore
1790 sslipi=sscalelip(fracinbuf)
1791 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1792 elseif (zi.gt.bufliptop) then
1793 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1794 sslipi=sscalelip(fracinbuf)
1795 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1805 C xi=xi+xshift*boxxsize
1806 C yi=yi+yshift*boxysize
1807 C zi=zi+zshift*boxzsize
1809 dxi=dc_norm(1,nres+i)
1810 dyi=dc_norm(2,nres+i)
1811 dzi=dc_norm(3,nres+i)
1812 c dsci_inv=dsc_inv(itypi)
1813 dsci_inv=vbld_inv(i+nres)
1814 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1815 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1817 C Calculate SC interaction energy.
1819 do iint=1,nint_gr(i)
1820 do j=istart(i,iint),iend(i,iint)
1821 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1823 c write(iout,*) "PRZED ZWYKLE", evdwij
1824 call dyn_ssbond_ene(i,j,evdwij)
1825 c write(iout,*) "PO ZWYKLE", evdwij
1828 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1829 & 'evdw',i,j,evdwij,' ss'
1830 C triple bond artifac removal
1831 do k=j+1,iend(i,iint)
1832 C search over all next residues
1833 if (dyn_ss_mask(k)) then
1834 C check if they are cysteins
1835 C write(iout,*) 'k=',k
1837 c write(iout,*) "PRZED TRI", evdwij
1838 evdwij_przed_tri=evdwij
1839 call triple_ssbond_ene(i,j,k,evdwij)
1840 c if(evdwij_przed_tri.ne.evdwij) then
1841 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1844 c write(iout,*) "PO TRI", evdwij
1845 C call the energy function that removes the artifical triple disulfide
1846 C bond the soubroutine is located in ssMD.F
1848 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1849 & 'evdw',i,j,evdwij,'tss'
1850 endif!dyn_ss_mask(k)
1854 itypj=iabs(itype(j))
1855 if (itypj.eq.ntyp1) cycle
1856 c dscj_inv=dsc_inv(itypj)
1857 dscj_inv=vbld_inv(j+nres)
1858 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1859 c & 1.0d0/vbld(j+nres)
1860 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1861 sig0ij=sigma(itypi,itypj)
1862 chi1=chi(itypi,itypj)
1863 chi2=chi(itypj,itypi)
1870 alf12=0.5D0*(alf1+alf2)
1871 C For diagnostics only!!!
1884 C Return atom J into box the original box
1886 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1887 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1888 C Condition for being inside the proper box
1889 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1890 c & (xj.lt.((-0.5d0)*boxxsize))) then
1894 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1895 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1896 C Condition for being inside the proper box
1897 c if ((yj.gt.((0.5d0)*boxysize)).or.
1898 c & (yj.lt.((-0.5d0)*boxysize))) then
1902 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1903 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1904 C Condition for being inside the proper box
1905 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1906 c & (zj.lt.((-0.5d0)*boxzsize))) then
1910 if (xj.lt.0) xj=xj+boxxsize
1912 if (yj.lt.0) yj=yj+boxysize
1914 if (zj.lt.0) zj=zj+boxzsize
1915 if ((zj.gt.bordlipbot)
1916 &.and.(zj.lt.bordliptop)) then
1917 C the energy transfer exist
1918 if (zj.lt.buflipbot) then
1919 C what fraction I am in
1921 & ((zj-bordlipbot)/lipbufthick)
1922 C lipbufthick is thickenes of lipid buffore
1923 sslipj=sscalelip(fracinbuf)
1924 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1925 elseif (zj.gt.bufliptop) then
1926 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1927 sslipj=sscalelip(fracinbuf)
1928 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1937 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1938 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1939 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1940 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1941 C write(iout,*) "tu,", i,j,aa_lip(itypi,itypj),bb_lip(itypi,itypj)
1942 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1943 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1944 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1945 C print *,sslipi,sslipj,bordlipbot,zi,zj
1946 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1954 xj=xj_safe+xshift*boxxsize
1955 yj=yj_safe+yshift*boxysize
1956 zj=zj_safe+zshift*boxzsize
1957 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1958 if(dist_temp.lt.dist_init) then
1968 if (subchap.eq.1) then
1977 dxj=dc_norm(1,nres+j)
1978 dyj=dc_norm(2,nres+j)
1979 dzj=dc_norm(3,nres+j)
1983 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1984 c write (iout,*) "j",j," dc_norm",
1985 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1986 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1988 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1989 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1991 c write (iout,'(a7,4f8.3)')
1992 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1993 if (sss.gt.0.0d0) then
1994 C Calculate angle-dependent terms of energy and contributions to their
1998 sig=sig0ij*dsqrt(sigsq)
1999 rij_shift=1.0D0/rij-sig+sig0ij
2000 c for diagnostics; uncomment
2001 c rij_shift=1.2*sig0ij
2002 C I hate to put IF's in the loops, but here don't have another choice!!!!
2003 if (rij_shift.le.0.0D0) then
2005 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2006 cd & restyp(itypi),i,restyp(itypj),j,
2007 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
2011 c---------------------------------------------------------------
2012 rij_shift=1.0D0/rij_shift
2013 fac=rij_shift**expon
2014 C here to start with
2019 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2020 eps2der=evdwij*eps3rt
2021 eps3der=evdwij*eps2rt
2022 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
2023 C &((sslipi+sslipj)/2.0d0+
2024 C &(2.0d0-sslipi-sslipj)/2.0d0)
2025 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
2026 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
2027 evdwij=evdwij*eps2rt*eps3rt
2028 evdw=evdw+evdwij*sss
2030 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2032 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2033 & restyp(itypi),i,restyp(itypj),j,
2034 & epsi,sigm,chi1,chi2,chip1,chip2,
2035 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
2036 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2040 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2043 C Calculate gradient components.
2044 e1=e1*eps1*eps2rt**2*eps3rt**2
2045 fac=-expon*(e1+evdwij)*rij_shift
2048 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
2049 c & evdwij,fac,sigma(itypi,itypj),expon
2050 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2052 C Calculate the radial part of the gradient
2053 gg_lipi(3)=eps1*(eps2rt*eps2rt)
2054 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
2055 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
2056 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
2057 gg_lipj(3)=ssgradlipj*gg_lipi(3)
2058 gg_lipi(3)=gg_lipi(3)*ssgradlipi
2064 C Calculate angular part of the gradient.
2074 c write (iout,*) "Number of loop steps in EGB:",ind
2075 cccc energy_dec=.false.
2078 C-----------------------------------------------------------------------------
2079 subroutine egbv(evdw)
2081 C This subroutine calculates the interaction energy of nonbonded side chains
2082 C assuming the Gay-Berne-Vorobjev potential of interaction.
2084 implicit real*8 (a-h,o-z)
2085 include 'DIMENSIONS'
2086 include 'COMMON.GEO'
2087 include 'COMMON.VAR'
2088 include 'COMMON.LOCAL'
2089 include 'COMMON.CHAIN'
2090 include 'COMMON.DERIV'
2091 include 'COMMON.NAMES'
2092 include 'COMMON.INTERACT'
2093 include 'COMMON.IOUNITS'
2094 include 'COMMON.CALC'
2095 common /srutu/ icall
2098 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
2101 c if (icall.eq.0) lprn=.true.
2103 do i=iatsc_s,iatsc_e
2104 itypi=iabs(itype(i))
2105 if (itypi.eq.ntyp1) cycle
2106 itypi1=iabs(itype(i+1))
2111 if (xi.lt.0) xi=xi+boxxsize
2113 if (yi.lt.0) yi=yi+boxysize
2115 if (zi.lt.0) zi=zi+boxzsize
2116 C define scaling factor for lipids
2118 C if (positi.le.0) positi=positi+boxzsize
2120 C first for peptide groups
2121 c for each residue check if it is in lipid or lipid water border area
2122 if ((zi.gt.bordlipbot)
2123 &.and.(zi.lt.bordliptop)) then
2124 C the energy transfer exist
2125 if (zi.lt.buflipbot) then
2126 C what fraction I am in
2128 & ((zi-bordlipbot)/lipbufthick)
2129 C lipbufthick is thickenes of lipid buffore
2130 sslipi=sscalelip(fracinbuf)
2131 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
2132 elseif (zi.gt.bufliptop) then
2133 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
2134 sslipi=sscalelip(fracinbuf)
2135 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
2145 dxi=dc_norm(1,nres+i)
2146 dyi=dc_norm(2,nres+i)
2147 dzi=dc_norm(3,nres+i)
2148 c dsci_inv=dsc_inv(itypi)
2149 dsci_inv=vbld_inv(i+nres)
2151 C Calculate SC interaction energy.
2153 do iint=1,nint_gr(i)
2154 do j=istart(i,iint),iend(i,iint)
2156 itypj=iabs(itype(j))
2157 if (itypj.eq.ntyp1) cycle
2158 c dscj_inv=dsc_inv(itypj)
2159 dscj_inv=vbld_inv(j+nres)
2160 sig0ij=sigma(itypi,itypj)
2161 r0ij=r0(itypi,itypj)
2162 chi1=chi(itypi,itypj)
2163 chi2=chi(itypj,itypi)
2170 alf12=0.5D0*(alf1+alf2)
2171 C For diagnostics only!!!
2185 if (xj.lt.0) xj=xj+boxxsize
2187 if (yj.lt.0) yj=yj+boxysize
2189 if (zj.lt.0) zj=zj+boxzsize
2190 if ((zj.gt.bordlipbot)
2191 &.and.(zj.lt.bordliptop)) then
2192 C the energy transfer exist
2193 if (zj.lt.buflipbot) then
2194 C what fraction I am in
2196 & ((zj-bordlipbot)/lipbufthick)
2197 C lipbufthick is thickenes of lipid buffore
2198 sslipj=sscalelip(fracinbuf)
2199 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
2200 elseif (zj.gt.bufliptop) then
2201 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
2202 sslipj=sscalelip(fracinbuf)
2203 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
2212 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
2213 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2214 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
2215 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
2216 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
2217 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
2218 C write(iout,*) "tu,", i,j,aa,bb,aa_lip(itypi,itypj),sslipi,sslipj
2219 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2227 xj=xj_safe+xshift*boxxsize
2228 yj=yj_safe+yshift*boxysize
2229 zj=zj_safe+zshift*boxzsize
2230 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2231 if(dist_temp.lt.dist_init) then
2241 if (subchap.eq.1) then
2250 dxj=dc_norm(1,nres+j)
2251 dyj=dc_norm(2,nres+j)
2252 dzj=dc_norm(3,nres+j)
2253 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2255 C Calculate angle-dependent terms of energy and contributions to their
2259 sig=sig0ij*dsqrt(sigsq)
2260 rij_shift=1.0D0/rij-sig+r0ij
2261 C I hate to put IF's in the loops, but here don't have another choice!!!!
2262 if (rij_shift.le.0.0D0) then
2267 c---------------------------------------------------------------
2268 rij_shift=1.0D0/rij_shift
2269 fac=rij_shift**expon
2272 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2273 eps2der=evdwij*eps3rt
2274 eps3der=evdwij*eps2rt
2275 fac_augm=rrij**expon
2276 e_augm=augm(itypi,itypj)*fac_augm
2277 evdwij=evdwij*eps2rt*eps3rt
2278 evdw=evdw+evdwij+e_augm
2280 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2282 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2283 & restyp(itypi),i,restyp(itypj),j,
2284 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2285 & chi1,chi2,chip1,chip2,
2286 & eps1,eps2rt**2,eps3rt**2,
2287 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2290 C Calculate gradient components.
2291 e1=e1*eps1*eps2rt**2*eps3rt**2
2292 fac=-expon*(e1+evdwij)*rij_shift
2294 fac=rij*fac-2*expon*rrij*e_augm
2295 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2296 C Calculate the radial part of the gradient
2300 C Calculate angular part of the gradient.
2306 C-----------------------------------------------------------------------------
2307 subroutine sc_angular
2308 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2309 C om12. Called by ebp, egb, and egbv.
2311 include 'COMMON.CALC'
2312 include 'COMMON.IOUNITS'
2316 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2317 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2318 om12=dxi*dxj+dyi*dyj+dzi*dzj
2320 C Calculate eps1(om12) and its derivative in om12
2321 faceps1=1.0D0-om12*chiom12
2322 faceps1_inv=1.0D0/faceps1
2323 eps1=dsqrt(faceps1_inv)
2324 C Following variable is eps1*deps1/dom12
2325 eps1_om12=faceps1_inv*chiom12
2330 c write (iout,*) "om12",om12," eps1",eps1
2331 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2336 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2337 sigsq=1.0D0-facsig*faceps1_inv
2338 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2339 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2340 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2346 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2347 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2349 C Calculate eps2 and its derivatives in om1, om2, and om12.
2352 chipom12=chip12*om12
2353 facp=1.0D0-om12*chipom12
2355 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2356 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2357 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2358 C Following variable is the square root of eps2
2359 eps2rt=1.0D0-facp1*facp_inv
2360 C Following three variables are the derivatives of the square root of eps
2361 C in om1, om2, and om12.
2362 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2363 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2364 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2365 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2366 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2367 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2368 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2369 c & " eps2rt_om12",eps2rt_om12
2370 C Calculate whole angle-dependent part of epsilon and contributions
2371 C to its derivatives
2374 C----------------------------------------------------------------------------
2376 implicit real*8 (a-h,o-z)
2377 include 'DIMENSIONS'
2378 include 'COMMON.CHAIN'
2379 include 'COMMON.DERIV'
2380 include 'COMMON.CALC'
2381 include 'COMMON.IOUNITS'
2382 double precision dcosom1(3),dcosom2(3)
2383 cc print *,'sss=',sss
2384 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2385 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2386 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2387 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2391 c eom12=evdwij*eps1_om12
2393 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2394 c & " sigder",sigder
2395 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2396 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2398 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2399 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2402 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2404 c write (iout,*) "gg",(gg(k),k=1,3)
2406 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2407 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2408 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2409 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2410 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2411 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2412 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2413 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2414 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2415 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2418 C Calculate the components of the gradient in DC and X
2422 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2426 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2427 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2431 C-----------------------------------------------------------------------
2432 subroutine e_softsphere(evdw)
2434 C This subroutine calculates the interaction energy of nonbonded side chains
2435 C assuming the LJ potential of interaction.
2437 implicit real*8 (a-h,o-z)
2438 include 'DIMENSIONS'
2439 parameter (accur=1.0d-10)
2440 include 'COMMON.GEO'
2441 include 'COMMON.VAR'
2442 include 'COMMON.LOCAL'
2443 include 'COMMON.CHAIN'
2444 include 'COMMON.DERIV'
2445 include 'COMMON.INTERACT'
2446 include 'COMMON.TORSION'
2447 include 'COMMON.SBRIDGE'
2448 include 'COMMON.NAMES'
2449 include 'COMMON.IOUNITS'
2450 include 'COMMON.CONTACTS'
2452 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2454 do i=iatsc_s,iatsc_e
2455 itypi=iabs(itype(i))
2456 if (itypi.eq.ntyp1) cycle
2457 itypi1=iabs(itype(i+1))
2462 C Calculate SC interaction energy.
2464 do iint=1,nint_gr(i)
2465 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2466 cd & 'iend=',iend(i,iint)
2467 do j=istart(i,iint),iend(i,iint)
2468 itypj=iabs(itype(j))
2469 if (itypj.eq.ntyp1) cycle
2473 rij=xj*xj+yj*yj+zj*zj
2474 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2475 r0ij=r0(itypi,itypj)
2477 c print *,i,j,r0ij,dsqrt(rij)
2478 if (rij.lt.r0ijsq) then
2479 evdwij=0.25d0*(rij-r0ijsq)**2
2487 C Calculate the components of the gradient in DC and X
2493 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2494 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2495 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2496 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2500 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2508 C--------------------------------------------------------------------------
2509 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2512 C Soft-sphere potential of p-p interaction
2514 implicit real*8 (a-h,o-z)
2515 include 'DIMENSIONS'
2516 include 'COMMON.CONTROL'
2517 include 'COMMON.IOUNITS'
2518 include 'COMMON.GEO'
2519 include 'COMMON.VAR'
2520 include 'COMMON.LOCAL'
2521 include 'COMMON.CHAIN'
2522 include 'COMMON.DERIV'
2523 include 'COMMON.INTERACT'
2524 include 'COMMON.CONTACTS'
2525 include 'COMMON.TORSION'
2526 include 'COMMON.VECTORS'
2527 include 'COMMON.FFIELD'
2529 C write(iout,*) 'In EELEC_soft_sphere'
2536 do i=iatel_s,iatel_e
2537 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2541 xmedi=c(1,i)+0.5d0*dxi
2542 ymedi=c(2,i)+0.5d0*dyi
2543 zmedi=c(3,i)+0.5d0*dzi
2544 xmedi=mod(xmedi,boxxsize)
2545 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2546 ymedi=mod(ymedi,boxysize)
2547 if (ymedi.lt.0) ymedi=ymedi+boxysize
2548 zmedi=mod(zmedi,boxzsize)
2549 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2551 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2552 do j=ielstart(i),ielend(i)
2553 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2557 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2558 r0ij=rpp(iteli,itelj)
2567 if (xj.lt.0) xj=xj+boxxsize
2569 if (yj.lt.0) yj=yj+boxysize
2571 if (zj.lt.0) zj=zj+boxzsize
2572 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2580 xj=xj_safe+xshift*boxxsize
2581 yj=yj_safe+yshift*boxysize
2582 zj=zj_safe+zshift*boxzsize
2583 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2584 if(dist_temp.lt.dist_init) then
2594 if (isubchap.eq.1) then
2603 rij=xj*xj+yj*yj+zj*zj
2604 sss=sscale(sqrt(rij))
2605 sssgrad=sscagrad(sqrt(rij))
2606 if (rij.lt.r0ijsq) then
2607 evdw1ij=0.25d0*(rij-r0ijsq)**2
2613 evdw1=evdw1+evdw1ij*sss
2615 C Calculate contributions to the Cartesian gradient.
2617 ggg(1)=fac*xj*sssgrad
2618 ggg(2)=fac*yj*sssgrad
2619 ggg(3)=fac*zj*sssgrad
2621 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2622 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2625 * Loop over residues i+1 thru j-1.
2629 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2634 cgrad do i=nnt,nct-1
2636 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2638 cgrad do j=i+1,nct-1
2640 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2646 c------------------------------------------------------------------------------
2647 subroutine vec_and_deriv
2648 implicit real*8 (a-h,o-z)
2649 include 'DIMENSIONS'
2653 include 'COMMON.IOUNITS'
2654 include 'COMMON.GEO'
2655 include 'COMMON.VAR'
2656 include 'COMMON.LOCAL'
2657 include 'COMMON.CHAIN'
2658 include 'COMMON.VECTORS'
2659 include 'COMMON.SETUP'
2660 include 'COMMON.TIME1'
2661 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2662 C Compute the local reference systems. For reference system (i), the
2663 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2664 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2666 do i=ivec_start,ivec_end
2670 if (i.eq.nres-1) then
2671 C Case of the last full residue
2672 C Compute the Z-axis
2673 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2674 costh=dcos(pi-theta(nres))
2675 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2679 C Compute the derivatives of uz
2681 uzder(2,1,1)=-dc_norm(3,i-1)
2682 uzder(3,1,1)= dc_norm(2,i-1)
2683 uzder(1,2,1)= dc_norm(3,i-1)
2685 uzder(3,2,1)=-dc_norm(1,i-1)
2686 uzder(1,3,1)=-dc_norm(2,i-1)
2687 uzder(2,3,1)= dc_norm(1,i-1)
2690 uzder(2,1,2)= dc_norm(3,i)
2691 uzder(3,1,2)=-dc_norm(2,i)
2692 uzder(1,2,2)=-dc_norm(3,i)
2694 uzder(3,2,2)= dc_norm(1,i)
2695 uzder(1,3,2)= dc_norm(2,i)
2696 uzder(2,3,2)=-dc_norm(1,i)
2698 C Compute the Y-axis
2701 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2703 C Compute the derivatives of uy
2706 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2707 & -dc_norm(k,i)*dc_norm(j,i-1)
2708 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2710 uyder(j,j,1)=uyder(j,j,1)-costh
2711 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2716 uygrad(l,k,j,i)=uyder(l,k,j)
2717 uzgrad(l,k,j,i)=uzder(l,k,j)
2721 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2722 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2723 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2724 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2727 C Compute the Z-axis
2728 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2729 costh=dcos(pi-theta(i+2))
2730 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2734 C Compute the derivatives of uz
2736 uzder(2,1,1)=-dc_norm(3,i+1)
2737 uzder(3,1,1)= dc_norm(2,i+1)
2738 uzder(1,2,1)= dc_norm(3,i+1)
2740 uzder(3,2,1)=-dc_norm(1,i+1)
2741 uzder(1,3,1)=-dc_norm(2,i+1)
2742 uzder(2,3,1)= dc_norm(1,i+1)
2745 uzder(2,1,2)= dc_norm(3,i)
2746 uzder(3,1,2)=-dc_norm(2,i)
2747 uzder(1,2,2)=-dc_norm(3,i)
2749 uzder(3,2,2)= dc_norm(1,i)
2750 uzder(1,3,2)= dc_norm(2,i)
2751 uzder(2,3,2)=-dc_norm(1,i)
2753 C Compute the Y-axis
2756 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2758 C Compute the derivatives of uy
2761 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2762 & -dc_norm(k,i)*dc_norm(j,i+1)
2763 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2765 uyder(j,j,1)=uyder(j,j,1)-costh
2766 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2771 uygrad(l,k,j,i)=uyder(l,k,j)
2772 uzgrad(l,k,j,i)=uzder(l,k,j)
2776 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2777 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2778 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2779 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2783 vbld_inv_temp(1)=vbld_inv(i+1)
2784 if (i.lt.nres-1) then
2785 vbld_inv_temp(2)=vbld_inv(i+2)
2787 vbld_inv_temp(2)=vbld_inv(i)
2792 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2793 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2798 #if defined(PARVEC) && defined(MPI)
2799 if (nfgtasks1.gt.1) then
2801 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2802 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2803 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2804 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2805 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2807 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2808 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2810 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2811 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2812 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2813 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2814 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2815 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2816 time_gather=time_gather+MPI_Wtime()-time00
2818 c if (fg_rank.eq.0) then
2819 c write (iout,*) "Arrays UY and UZ"
2821 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2828 C-----------------------------------------------------------------------------
2829 subroutine check_vecgrad
2830 implicit real*8 (a-h,o-z)
2831 include 'DIMENSIONS'
2832 include 'COMMON.IOUNITS'
2833 include 'COMMON.GEO'
2834 include 'COMMON.VAR'
2835 include 'COMMON.LOCAL'
2836 include 'COMMON.CHAIN'
2837 include 'COMMON.VECTORS'
2838 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2839 dimension uyt(3,maxres),uzt(3,maxres)
2840 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2841 double precision delta /1.0d-7/
2844 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2845 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2846 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2847 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2848 cd & (dc_norm(if90,i),if90=1,3)
2849 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2850 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2851 cd write(iout,'(a)')
2857 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2858 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2871 cd write (iout,*) 'i=',i
2873 erij(k)=dc_norm(k,i)
2877 dc_norm(k,i)=erij(k)
2879 dc_norm(j,i)=dc_norm(j,i)+delta
2880 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2882 c dc_norm(k,i)=dc_norm(k,i)/fac
2884 c write (iout,*) (dc_norm(k,i),k=1,3)
2885 c write (iout,*) (erij(k),k=1,3)
2888 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2889 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2890 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2891 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2893 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2894 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2895 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2898 dc_norm(k,i)=erij(k)
2901 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2902 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2903 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2904 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2905 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2906 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2907 cd write (iout,'(a)')
2912 C--------------------------------------------------------------------------
2913 subroutine set_matrices
2914 implicit real*8 (a-h,o-z)
2915 include 'DIMENSIONS'
2918 include "COMMON.SETUP"
2920 integer status(MPI_STATUS_SIZE)
2922 include 'COMMON.IOUNITS'
2923 include 'COMMON.GEO'
2924 include 'COMMON.VAR'
2925 include 'COMMON.LOCAL'
2926 include 'COMMON.CHAIN'
2927 include 'COMMON.DERIV'
2928 include 'COMMON.INTERACT'
2929 include 'COMMON.CONTACTS'
2930 include 'COMMON.TORSION'
2931 include 'COMMON.VECTORS'
2932 include 'COMMON.FFIELD'
2933 double precision auxvec(2),auxmat(2,2)
2935 C Compute the virtual-bond-torsional-angle dependent quantities needed
2936 C to calculate the el-loc multibody terms of various order.
2938 c write(iout,*) 'nphi=',nphi,nres
2940 do i=ivec_start+2,ivec_end+2
2945 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2946 iti = itype2loc(itype(i-2))
2950 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2951 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2952 iti1 = itype2loc(itype(i-1))
2957 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0d0)
2958 & +bnew1(2,1,iti)*dsin(theta(i-1))
2959 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0d0)
2960 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2961 & +bnew1(2,1,iti)*dcos(theta(i-1))
2962 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2963 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2964 c &*(cos(theta(i)/2.0)
2965 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0d0)
2966 & +bnew2(2,1,iti)*dsin(theta(i-1))
2967 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0d0)
2968 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2969 c &*(cos(theta(i)/2.0)
2970 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2971 & +bnew2(2,1,iti)*dcos(theta(i-1))
2972 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2973 c if (ggb1(1,i).eq.0.0d0) then
2974 c write(iout,*) 'i=',i,ggb1(1,i),
2975 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2976 c &bnew1(2,1,iti)*cos(theta(i)),
2977 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2979 b1(2,i-2)=bnew1(1,2,iti)
2981 b2(2,i-2)=bnew2(1,2,iti)
2983 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2984 EE(1,2,i-2)=eeold(1,2,iti)
2985 EE(2,1,i-2)=eeold(2,1,iti)
2986 EE(2,2,i-2)=eeold(2,2,iti)
2987 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2992 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2993 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2994 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2995 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2996 b1tilde(1,i-2)=b1(1,i-2)
2997 b1tilde(2,i-2)=-b1(2,i-2)
2998 b2tilde(1,i-2)=b2(1,i-2)
2999 b2tilde(2,i-2)=-b2(2,i-2)
3000 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
3001 c write(iout,*) 'b1=',b1(1,i-2)
3002 c write (iout,*) 'theta=', theta(i-1)
3005 if (i.gt. nnt+2 .and. i.lt.nct+2) then
3006 iti = itype2loc(itype(i-2))
3010 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3011 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3012 iti1 = itype2loc(itype(i-1))
3020 b1tilde(1,i-2)=b1(1,i-2)
3021 b1tilde(2,i-2)=-b1(2,i-2)
3022 b2tilde(1,i-2)=b2(1,i-2)
3023 b2tilde(2,i-2)=-b2(2,i-2)
3024 EE(1,2,i-2)=eeold(1,2,iti)
3025 EE(2,1,i-2)=eeold(2,1,iti)
3026 EE(2,2,i-2)=eeold(2,2,iti)
3027 EE(1,1,i-2)=eeold(1,1,iti)
3031 do i=ivec_start+2,ivec_end+2
3035 if (i .lt. nres+1) then
3072 if (i .gt. 3 .and. i .lt. nres+1) then
3073 obrot_der(1,i-2)=-sin1
3074 obrot_der(2,i-2)= cos1
3075 Ugder(1,1,i-2)= sin1
3076 Ugder(1,2,i-2)=-cos1
3077 Ugder(2,1,i-2)=-cos1
3078 Ugder(2,2,i-2)=-sin1
3081 obrot2_der(1,i-2)=-dwasin2
3082 obrot2_der(2,i-2)= dwacos2
3083 Ug2der(1,1,i-2)= dwasin2
3084 Ug2der(1,2,i-2)=-dwacos2
3085 Ug2der(2,1,i-2)=-dwacos2
3086 Ug2der(2,2,i-2)=-dwasin2
3088 obrot_der(1,i-2)=0.0d0
3089 obrot_der(2,i-2)=0.0d0
3090 Ugder(1,1,i-2)=0.0d0
3091 Ugder(1,2,i-2)=0.0d0
3092 Ugder(2,1,i-2)=0.0d0
3093 Ugder(2,2,i-2)=0.0d0
3094 obrot2_der(1,i-2)=0.0d0
3095 obrot2_der(2,i-2)=0.0d0
3096 Ug2der(1,1,i-2)=0.0d0
3097 Ug2der(1,2,i-2)=0.0d0
3098 Ug2der(2,1,i-2)=0.0d0
3099 Ug2der(2,2,i-2)=0.0d0
3101 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
3102 if (i.gt. nnt+2 .and. i.lt.nct+2) then
3103 iti = itype2loc(itype(i-2))
3107 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3108 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3109 iti1 = itype2loc(itype(i-1))
3113 cd write (iout,*) '*******i',i,' iti1',iti
3114 cd write (iout,*) 'b1',b1(:,iti)
3115 cd write (iout,*) 'b2',b2(:,iti)
3116 cd write (iout,*) 'Ug',Ug(:,:,i-2)
3117 c if (i .gt. iatel_s+2) then
3118 if (i .gt. nnt+2) then
3119 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
3121 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
3122 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
3124 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
3125 c & EE(1,2,iti),EE(2,2,i)
3126 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
3127 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
3128 c write(iout,*) "Macierz EUG",
3129 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
3131 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3133 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
3134 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
3135 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
3136 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
3137 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
3148 DtUg2(l,k,i-2)=0.0d0
3152 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
3153 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
3155 muder(k,i-2)=Ub2der(k,i-2)
3157 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3158 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3159 if (itype(i-1).le.ntyp) then
3160 iti1 = itype2loc(itype(i-1))
3168 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
3171 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
3172 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
3173 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
3174 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
3175 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
3176 & ((ee(l,k,i-2),l=1,2),k=1,2),eenew(1,itype2loc(iti))
3178 cd write (iout,*) 'mu1',mu1(:,i-2)
3179 cd write (iout,*) 'mu2',mu2(:,i-2)
3180 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3182 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3183 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
3184 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3185 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
3186 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3187 C Vectors and matrices dependent on a single virtual-bond dihedral.
3188 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
3189 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3190 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3191 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
3192 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
3193 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3194 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3195 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3196 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3199 C Matrices dependent on two consecutive virtual-bond dihedrals.
3200 C The order of matrices is from left to right.
3201 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3203 c do i=max0(ivec_start,2),ivec_end
3205 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3206 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3207 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3208 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3209 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3210 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3211 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3212 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3215 #if defined(MPI) && defined(PARMAT)
3217 c if (fg_rank.eq.0) then
3218 write (iout,*) "Arrays UG and UGDER before GATHER"
3220 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3221 & ((ug(l,k,i),l=1,2),k=1,2),
3222 & ((ugder(l,k,i),l=1,2),k=1,2)
3224 write (iout,*) "Arrays UG2 and UG2DER"
3226 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3227 & ((ug2(l,k,i),l=1,2),k=1,2),
3228 & ((ug2der(l,k,i),l=1,2),k=1,2)
3230 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3232 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3233 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3234 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3236 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3238 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3239 & costab(i),sintab(i),costab2(i),sintab2(i)
3241 write (iout,*) "Array MUDER"
3243 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3247 if (nfgtasks.gt.1) then
3249 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
3250 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
3251 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
3253 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
3254 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3256 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
3257 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3259 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
3260 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3262 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
3263 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3265 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
3266 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3268 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
3269 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3271 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
3272 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
3273 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3274 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
3275 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
3276 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3277 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
3278 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
3279 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3280 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
3281 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
3282 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3283 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3285 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
3286 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3288 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
3289 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3291 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
3292 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3294 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3295 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3297 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3298 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3300 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3301 & ivec_count(fg_rank1),
3302 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3304 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3305 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3307 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3308 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3310 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3311 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3313 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3314 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3316 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3317 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3319 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3320 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3322 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3323 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3325 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3326 & ivec_count(fg_rank1),
3327 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3329 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3330 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3332 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3333 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3335 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3336 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3338 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3339 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3341 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3342 & ivec_count(fg_rank1),
3343 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3345 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3346 & ivec_count(fg_rank1),
3347 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3349 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3350 & ivec_count(fg_rank1),
3351 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3352 & MPI_MAT2,FG_COMM1,IERR)
3353 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3354 & ivec_count(fg_rank1),
3355 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3356 & MPI_MAT2,FG_COMM1,IERR)
3359 c Passes matrix info through the ring
3362 if (irecv.lt.0) irecv=nfgtasks1-1
3365 if (inext.ge.nfgtasks1) inext=0
3367 c write (iout,*) "isend",isend," irecv",irecv
3369 lensend=lentyp(isend)
3370 lenrecv=lentyp(irecv)
3371 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3372 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3373 c & MPI_ROTAT1(lensend),inext,2200+isend,
3374 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3375 c & iprev,2200+irecv,FG_COMM,status,IERR)
3376 c write (iout,*) "Gather ROTAT1"
3378 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3379 c & MPI_ROTAT2(lensend),inext,3300+isend,
3380 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3381 c & iprev,3300+irecv,FG_COMM,status,IERR)
3382 c write (iout,*) "Gather ROTAT2"
3384 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3385 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3386 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3387 & iprev,4400+irecv,FG_COMM,status,IERR)
3388 c write (iout,*) "Gather ROTAT_OLD"
3390 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3391 & MPI_PRECOMP11(lensend),inext,5500+isend,
3392 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3393 & iprev,5500+irecv,FG_COMM,status,IERR)
3394 c write (iout,*) "Gather PRECOMP11"
3396 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3397 & MPI_PRECOMP12(lensend),inext,6600+isend,
3398 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3399 & iprev,6600+irecv,FG_COMM,status,IERR)
3400 c write (iout,*) "Gather PRECOMP12"
3402 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3404 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3405 & MPI_ROTAT2(lensend),inext,7700+isend,
3406 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3407 & iprev,7700+irecv,FG_COMM,status,IERR)
3408 c write (iout,*) "Gather PRECOMP21"
3410 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3411 & MPI_PRECOMP22(lensend),inext,8800+isend,
3412 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3413 & iprev,8800+irecv,FG_COMM,status,IERR)
3414 c write (iout,*) "Gather PRECOMP22"
3416 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3417 & MPI_PRECOMP23(lensend),inext,9900+isend,
3418 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3419 & MPI_PRECOMP23(lenrecv),
3420 & iprev,9900+irecv,FG_COMM,status,IERR)
3421 c write (iout,*) "Gather PRECOMP23"
3426 if (irecv.lt.0) irecv=nfgtasks1-1
3429 time_gather=time_gather+MPI_Wtime()-time00
3432 c if (fg_rank.eq.0) then
3433 write (iout,*) "Arrays UG and UGDER"
3435 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3436 & ((ug(l,k,i),l=1,2),k=1,2),
3437 & ((ugder(l,k,i),l=1,2),k=1,2)
3439 write (iout,*) "Arrays UG2 and UG2DER"
3441 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3442 & ((ug2(l,k,i),l=1,2),k=1,2),
3443 & ((ug2der(l,k,i),l=1,2),k=1,2)
3445 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3447 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3448 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3449 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3451 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3453 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3454 & costab(i),sintab(i),costab2(i),sintab2(i)
3456 write (iout,*) "Array MUDER"
3458 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3464 cd iti = itype2loc(itype(i))
3467 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3468 cd & (EE(j,k,i),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3473 C--------------------------------------------------------------------------
3474 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3476 C This subroutine calculates the average interaction energy and its gradient
3477 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3478 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3479 C The potential depends both on the distance of peptide-group centers and on
3480 C the orientation of the CA-CA virtual bonds.
3482 implicit real*8 (a-h,o-z)
3486 include 'DIMENSIONS'
3487 include 'COMMON.CONTROL'
3488 include 'COMMON.SETUP'
3489 include 'COMMON.IOUNITS'
3490 include 'COMMON.GEO'
3491 include 'COMMON.VAR'
3492 include 'COMMON.LOCAL'
3493 include 'COMMON.CHAIN'
3494 include 'COMMON.DERIV'
3495 include 'COMMON.INTERACT'
3496 include 'COMMON.CONTACTS'
3497 include 'COMMON.TORSION'
3498 include 'COMMON.VECTORS'
3499 include 'COMMON.FFIELD'
3500 include 'COMMON.TIME1'
3501 include 'COMMON.SPLITELE'
3502 include 'COMMON.SHIELD'
3503 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3504 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3505 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3506 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3507 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3508 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3510 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3512 double precision scal_el /1.0d0/
3514 double precision scal_el /0.5d0/
3517 C 13-go grudnia roku pamietnego...
3518 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3519 & 0.0d0,1.0d0,0.0d0,
3520 & 0.0d0,0.0d0,1.0d0/
3521 cd write(iout,*) 'In EELEC'
3523 cd write(iout,*) 'Type',i
3524 cd write(iout,*) 'B1',B1(:,i)
3525 cd write(iout,*) 'B2',B2(:,i)
3526 cd write(iout,*) 'CC',CC(:,:,i)
3527 cd write(iout,*) 'DD',DD(:,:,i)
3528 cd write(iout,*) 'EE',EE(:,:,i)
3530 cd call check_vecgrad
3532 if (icheckgrad.eq.1) then
3534 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3536 dc_norm(k,i)=dc(k,i)*fac
3538 c write (iout,*) 'i',i,' fac',fac
3541 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3542 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3543 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3544 c call vec_and_deriv
3550 time_mat=time_mat+MPI_Wtime()-time01
3554 cd write (iout,*) 'i=',i
3556 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3559 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3560 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3573 cd print '(a)','Enter EELEC'
3574 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3576 gel_loc_loc(i)=0.0d0
3581 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3583 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3585 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3586 do i=iturn3_start,iturn3_end
3588 C write(iout,*) "tu jest i",i
3589 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3590 C changes suggested by Ana to avoid out of bounds
3591 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
3592 c & .or.((i+4).gt.nres)
3593 c & .or.((i-1).le.0)
3594 C end of changes by Ana
3595 & .or. itype(i+2).eq.ntyp1
3596 & .or. itype(i+3).eq.ntyp1) cycle
3597 C Adam: Instructions below will switch off existing interactions
3599 c if(itype(i-1).eq.ntyp1)cycle
3601 c if(i.LT.nres-3)then
3602 c if (itype(i+4).eq.ntyp1) cycle
3607 dx_normi=dc_norm(1,i)
3608 dy_normi=dc_norm(2,i)
3609 dz_normi=dc_norm(3,i)
3610 xmedi=c(1,i)+0.5d0*dxi
3611 ymedi=c(2,i)+0.5d0*dyi
3612 zmedi=c(3,i)+0.5d0*dzi
3613 xmedi=mod(xmedi,boxxsize)
3614 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3615 ymedi=mod(ymedi,boxysize)
3616 if (ymedi.lt.0) ymedi=ymedi+boxysize
3617 zmedi=mod(zmedi,boxzsize)
3618 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3619 zmedi2=mod(zmedi,boxzsize)
3620 if (zmedi2.lt.0) zmedi2=zmedi2+boxzsize
3621 if ((zmedi2.gt.bordlipbot)
3622 &.and.(zmedi2.lt.bordliptop)) then
3623 C the energy transfer exist
3624 if (zmedi2.lt.buflipbot) then
3625 C what fraction I am in
3627 & ((zmedi2-bordlipbot)/lipbufthick)
3628 C lipbufthick is thickenes of lipid buffore
3629 sslipi=sscalelip(fracinbuf)
3630 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3631 elseif (zmedi2.gt.bufliptop) then
3632 fracinbuf=1.0d0-((bordliptop-zmedi2)/lipbufthick)
3633 sslipi=sscalelip(fracinbuf)
3634 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3644 call eelecij(i,i+2,ees,evdw1,eel_loc)
3645 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3646 num_cont_hb(i)=num_conti
3648 do i=iturn4_start,iturn4_end
3650 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3651 C changes suggested by Ana to avoid out of bounds
3652 c & .or.((i+5).gt.nres)
3653 c & .or.((i-1).le.0)
3654 C end of changes suggested by Ana
3655 & .or. itype(i+3).eq.ntyp1
3656 & .or. itype(i+4).eq.ntyp1
3657 c & .or. itype(i+5).eq.ntyp1
3658 c & .or. itype(i).eq.ntyp1
3659 c & .or. itype(i-1).eq.ntyp1
3664 dx_normi=dc_norm(1,i)
3665 dy_normi=dc_norm(2,i)
3666 dz_normi=dc_norm(3,i)
3667 xmedi=c(1,i)+0.5d0*dxi
3668 ymedi=c(2,i)+0.5d0*dyi
3669 zmedi=c(3,i)+0.5d0*dzi
3670 C Return atom into box, boxxsize is size of box in x dimension
3672 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3673 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3674 C Condition for being inside the proper box
3675 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3676 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3680 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3681 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3682 C Condition for being inside the proper box
3683 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3684 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3688 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3689 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3690 C Condition for being inside the proper box
3691 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3692 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3695 xmedi=mod(xmedi,boxxsize)
3696 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3697 ymedi=mod(ymedi,boxysize)
3698 if (ymedi.lt.0) ymedi=ymedi+boxysize
3699 zmedi=mod(zmedi,boxzsize)
3700 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3701 zmedi2=mod(zmedi,boxzsize)
3702 if (zmedi2.lt.0) zmedi2=zmedi2+boxzsize
3703 if ((zmedi2.gt.bordlipbot)
3704 &.and.(zmedi2.lt.bordliptop)) then
3705 C the energy transfer exist
3706 if (zmedi2.lt.buflipbot) then
3707 C what fraction I am in
3709 & ((zmedi2-bordlipbot)/lipbufthick)
3710 C lipbufthick is thickenes of lipid buffore
3711 sslipi=sscalelip(fracinbuf)
3712 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3713 elseif (zmedi2.gt.bufliptop) then
3714 fracinbuf=1.0d0-((bordliptop-zmedi2)/lipbufthick)
3715 sslipi=sscalelip(fracinbuf)
3716 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3725 num_conti=num_cont_hb(i)
3726 c write(iout,*) "JESTEM W PETLI"
3727 call eelecij(i,i+3,ees,evdw1,eel_loc)
3728 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3729 & call eturn4(i,eello_turn4)
3730 num_cont_hb(i)=num_conti
3732 C Loop over all neighbouring boxes
3737 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3740 do i=iatel_s,iatel_e
3743 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3744 C changes suggested by Ana to avoid out of bounds
3745 c & .or.((i+2).gt.nres)
3746 c & .or.((i-1).le.0)
3747 C end of changes by Ana
3748 c & .or. itype(i+2).eq.ntyp1
3749 c & .or. itype(i-1).eq.ntyp1
3754 dx_normi=dc_norm(1,i)
3755 dy_normi=dc_norm(2,i)
3756 dz_normi=dc_norm(3,i)
3757 xmedi=c(1,i)+0.5d0*dxi
3758 ymedi=c(2,i)+0.5d0*dyi
3759 zmedi=c(3,i)+0.5d0*dzi
3760 xmedi=mod(xmedi,boxxsize)
3761 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3762 ymedi=mod(ymedi,boxysize)
3763 if (ymedi.lt.0) ymedi=ymedi+boxysize
3764 zmedi=mod(zmedi,boxzsize)
3765 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3766 if ((zmedi.gt.bordlipbot)
3767 &.and.(zmedi.lt.bordliptop)) then
3768 C the energy transfer exist
3769 if (zmedi.lt.buflipbot) then
3770 C what fraction I am in
3772 & ((zmedi-bordlipbot)/lipbufthick)
3773 C lipbufthick is thickenes of lipid buffore
3774 sslipi=sscalelip(fracinbuf)
3775 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3776 elseif (zmedi.gt.bufliptop) then
3777 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3778 sslipi=sscalelip(fracinbuf)
3779 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3788 C print *,sslipi,"TU?!"
3789 C xmedi=xmedi+xshift*boxxsize
3790 C ymedi=ymedi+yshift*boxysize
3791 C zmedi=zmedi+zshift*boxzsize
3793 C Return tom into box, boxxsize is size of box in x dimension
3795 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3796 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3797 C Condition for being inside the proper box
3798 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3799 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3803 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3804 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3805 C Condition for being inside the proper box
3806 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3807 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3811 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3812 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3813 cC Condition for being inside the proper box
3814 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3815 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3819 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3820 num_conti=num_cont_hb(i)
3822 do j=ielstart(i),ielend(i)
3824 C write (iout,*) i,j
3826 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3827 C changes suggested by Ana to avoid out of bounds
3828 c & .or.((j+2).gt.nres)
3829 c & .or.((j-1).le.0)
3830 C end of changes by Ana
3831 c & .or.itype(j+2).eq.ntyp1
3832 c & .or.itype(j-1).eq.ntyp1
3834 call eelecij(i,j,ees,evdw1,eel_loc)
3836 num_cont_hb(i)=num_conti
3842 c write (iout,*) "Number of loop steps in EELEC:",ind
3844 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3845 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3847 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3848 ccc eel_loc=eel_loc+eello_turn3
3849 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3852 C-------------------------------------------------------------------------------
3853 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3854 implicit real*8 (a-h,o-z)
3855 include 'DIMENSIONS'
3859 include 'COMMON.CONTROL'
3860 include 'COMMON.IOUNITS'
3861 include 'COMMON.GEO'
3862 include 'COMMON.VAR'
3863 include 'COMMON.LOCAL'
3864 include 'COMMON.CHAIN'
3865 include 'COMMON.DERIV'
3866 include 'COMMON.INTERACT'
3867 include 'COMMON.CONTACTS'
3868 include 'COMMON.TORSION'
3869 include 'COMMON.VECTORS'
3870 include 'COMMON.FFIELD'
3871 include 'COMMON.TIME1'
3872 include 'COMMON.SPLITELE'
3873 include 'COMMON.SHIELD'
3874 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3875 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3876 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3877 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3878 & gmuij2(4),gmuji2(4)
3879 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3880 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3882 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3884 double precision scal_el /1.0d0/
3886 double precision scal_el /0.5d0/
3889 C 13-go grudnia roku pamietnego...
3890 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3891 & 0.0d0,1.0d0,0.0d0,
3892 & 0.0d0,0.0d0,1.0d0/
3893 integer xshift,yshift,zshift
3894 c time00=MPI_Wtime()
3895 cd write (iout,*) "eelecij",i,j
3899 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3900 aaa=app(iteli,itelj)
3901 bbb=bpp(iteli,itelj)
3902 ael6i=ael6(iteli,itelj)
3903 ael3i=ael3(iteli,itelj)
3907 dx_normj=dc_norm(1,j)
3908 dy_normj=dc_norm(2,j)
3909 dz_normj=dc_norm(3,j)
3910 C xj=c(1,j)+0.5D0*dxj-xmedi
3911 C yj=c(2,j)+0.5D0*dyj-ymedi
3912 C zj=c(3,j)+0.5D0*dzj-zmedi
3917 if (xj.lt.0) xj=xj+boxxsize
3919 if (yj.lt.0) yj=yj+boxysize
3921 if (zj.lt.0) zj=zj+boxzsize
3922 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3923 if ((zj.gt.bordlipbot)
3924 &.and.(zj.lt.bordliptop)) then
3925 C the energy transfer exist
3926 if (zj.lt.buflipbot) then
3927 C what fraction I am in
3929 & ((zj-bordlipbot)/lipbufthick)
3930 C lipbufthick is thickenes of lipid buffore
3931 sslipj=sscalelip(fracinbuf)
3932 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3933 elseif (zj.gt.bufliptop) then
3934 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3935 sslipj=sscalelip(fracinbuf)
3936 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3945 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3953 xj=xj_safe+xshift*boxxsize
3954 yj=yj_safe+yshift*boxysize
3955 zj=zj_safe+zshift*boxzsize
3956 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3957 if(dist_temp.lt.dist_init) then
3967 if (isubchap.eq.1) then
3976 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3978 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3979 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3980 C Condition for being inside the proper box
3981 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3982 c & (xj.lt.((-0.5d0)*boxxsize))) then
3986 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3987 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3988 C Condition for being inside the proper box
3989 c if ((yj.gt.((0.5d0)*boxysize)).or.
3990 c & (yj.lt.((-0.5d0)*boxysize))) then
3994 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3995 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3996 C Condition for being inside the proper box
3997 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3998 c & (zj.lt.((-0.5d0)*boxzsize))) then
4001 C endif !endPBC condintion
4005 rij=xj*xj+yj*yj+zj*zj
4007 sss=sscale(sqrt(rij))
4008 sssgrad=sscagrad(sqrt(rij))
4009 c if (sss.gt.0.0d0) then
4015 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
4016 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
4017 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
4018 fac=cosa-3.0D0*cosb*cosg
4020 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
4021 if (j.eq.i+2) ev1=scal_el*ev1
4026 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
4030 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
4031 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
4032 if (shield_mode.gt.0) then
4035 el1=el1*fac_shield(i)**2*fac_shield(j)**2
4036 el2=el2*fac_shield(i)**2*fac_shield(j)**2
4039 C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
4040 C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4046 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4047 C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
4049 evdw1=evdw1+evdwij*sss
4050 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4051 C print *,sslipi,sslipj,lipscale**2,
4052 C & (sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
4053 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
4054 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
4055 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
4056 cd & xmedi,ymedi,zmedi,xj,yj,zj
4058 if (energy_dec) then
4059 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
4061 &,iteli,itelj,aaa,evdw1
4063 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
4064 &fac_shield(i),fac_shield(j)
4068 C Calculate contributions to the Cartesian gradient.
4071 facvdw=-6*rrmij*(ev1+evdwij)*sss
4072 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4073 facel=-3*rrmij*(el1+eesij)
4074 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4081 * Radial derivatives. First process both termini of the fragment (i,j)
4086 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4087 & (shield_mode.gt.0)) then
4089 do ilist=1,ishield_list(i)
4090 iresshield=shield_list(ilist,i)
4092 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
4094 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
4096 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
4097 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
4098 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
4099 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
4100 C if (iresshield.gt.i) then
4101 C do ishi=i+1,iresshield-1
4102 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
4103 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
4107 C do ishi=iresshield,i
4108 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
4109 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
4115 do ilist=1,ishield_list(j)
4116 iresshield=shield_list(ilist,j)
4118 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
4120 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
4122 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
4123 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
4125 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4126 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
4127 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4128 C if (iresshield.gt.j) then
4129 C do ishi=j+1,iresshield-1
4130 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
4131 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4135 C do ishi=iresshield,j
4136 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
4137 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4144 gshieldc(k,i)=gshieldc(k,i)+
4145 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
4146 gshieldc(k,j)=gshieldc(k,j)+
4147 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
4148 gshieldc(k,i-1)=gshieldc(k,i-1)+
4149 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
4150 gshieldc(k,j-1)=gshieldc(k,j-1)+
4151 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
4156 c ghalf=0.5D0*ggg(k)
4157 c gelc(k,i)=gelc(k,i)+ghalf
4158 c gelc(k,j)=gelc(k,j)+ghalf
4160 c 9/28/08 AL Gradient compotents will be summed only at the end
4161 C print *,"before", gelc_long(1,i), gelc_long(1,j)
4163 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4164 C & +grad_shield(k,j)*eesij/fac_shield(j)
4165 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4166 C & +grad_shield(k,i)*eesij/fac_shield(i)
4167 C gelc_long(k,i-1)=gelc_long(k,i-1)
4168 C & +grad_shield(k,i)*eesij/fac_shield(i)
4169 C gelc_long(k,j-1)=gelc_long(k,j-1)
4170 C & +grad_shield(k,j)*eesij/fac_shield(j)
4172 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
4173 C Lipidic part for lipscale
4174 gelc_long(3,j)=gelc_long(3,j)+
4175 & ssgradlipj*eesij/2.0d0*lipscale**2
4177 gelc_long(3,i)=gelc_long(3,i)+
4178 & ssgradlipi*eesij/2.0d0*lipscale**2
4181 * Loop over residues i+1 thru j-1.
4185 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4188 if (sss.gt.0.0) then
4189 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
4190 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4192 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
4193 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4195 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
4196 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4203 c ghalf=0.5D0*ggg(k)
4204 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
4205 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
4207 c 9/28/08 AL Gradient compotents will be summed only at the end
4209 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4210 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4212 C Lipidic part for scaling weight
4213 gvdwpp(3,j)=gvdwpp(3,j)+
4214 & sss*ssgradlipj*evdwij/2.0d0*lipscale**2
4215 gvdwpp(3,i)=gvdwpp(3,i)+
4216 & sss*ssgradlipi*evdwij/2.0d0*lipscale**2
4219 * Loop over residues i+1 thru j-1.
4223 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
4228 facvdw=(ev1+evdwij)*sss
4229 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4232 fac=-3*rrmij*(facvdw+facvdw+facel)
4237 * Radial derivatives. First process both termini of the fragment (i,j)
4240 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
4242 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
4244 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
4246 c ghalf=0.5D0*ggg(k)
4247 c gelc(k,i)=gelc(k,i)+ghalf
4248 c gelc(k,j)=gelc(k,j)+ghalf
4250 c 9/28/08 AL Gradient compotents will be summed only at the end
4252 gelc_long(k,j)=gelc(k,j)+ggg(k)
4253 gelc_long(k,i)=gelc(k,i)-ggg(k)
4256 * Loop over residues i+1 thru j-1.
4260 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4263 c 9/28/08 AL Gradient compotents will be summed only at the end
4264 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
4265 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4267 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
4268 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4270 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
4271 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4273 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4274 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4276 gvdwpp(3,j)=gvdwpp(3,j)+
4277 & sss*ssgradlipj*evdwij/2.0d0*lipscale**2
4278 gvdwpp(3,i)=gvdwpp(3,i)+
4279 & sss*ssgradlipi*evdwij/2.0d0*lipscale**2
4285 ecosa=2.0D0*fac3*fac1+fac4
4288 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
4289 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
4291 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4292 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4294 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
4295 cd & (dcosg(k),k=1,3)
4297 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
4298 & fac_shield(i)**2*fac_shield(j)**2
4299 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4302 c ghalf=0.5D0*ggg(k)
4303 c gelc(k,i)=gelc(k,i)+ghalf
4304 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4305 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4306 c gelc(k,j)=gelc(k,j)+ghalf
4307 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4308 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4312 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4315 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
4318 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4319 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
4320 & *fac_shield(i)**2*fac_shield(j)**2
4321 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4323 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4324 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
4325 & *fac_shield(i)**2*fac_shield(j)**2
4326 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4327 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4328 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4330 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
4334 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
4335 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
4336 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4338 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
4339 C energy of a peptide unit is assumed in the form of a second-order
4340 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
4341 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
4342 C are computed for EVERY pair of non-contiguous peptide groups.
4345 if (j.lt.nres-1) then
4357 muij(kkk)=mu(k,i)*mu(l,j)
4358 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
4360 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
4361 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
4362 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
4363 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
4364 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
4365 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4369 cd write (iout,*) 'EELEC: i',i,' j',j
4370 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
4371 cd write(iout,*) 'muij',muij
4372 ury=scalar(uy(1,i),erij)
4373 urz=scalar(uz(1,i),erij)
4374 vry=scalar(uy(1,j),erij)
4375 vrz=scalar(uz(1,j),erij)
4376 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4377 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4378 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4379 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4380 fac=dsqrt(-ael6i)*r3ij
4385 cd write (iout,'(4i5,4f10.5)')
4386 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
4387 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4388 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4389 cd & uy(:,j),uz(:,j)
4390 cd write (iout,'(4f10.5)')
4391 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4392 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4393 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
4394 cd write (iout,'(9f10.5/)')
4395 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4396 C Derivatives of the elements of A in virtual-bond vectors
4397 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4399 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4400 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4401 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4402 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4403 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4404 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4405 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4406 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4407 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4408 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4409 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4410 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4412 C Compute radial contributions to the gradient
4430 C Add the contributions coming from er
4433 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4434 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4435 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4436 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4439 C Derivatives in DC(i)
4440 cgrad ghalf1=0.5d0*agg(k,1)
4441 cgrad ghalf2=0.5d0*agg(k,2)
4442 cgrad ghalf3=0.5d0*agg(k,3)
4443 cgrad ghalf4=0.5d0*agg(k,4)
4444 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
4445 & -3.0d0*uryg(k,2)*vry)!+ghalf1
4446 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
4447 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
4448 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
4449 & -3.0d0*urzg(k,2)*vry)!+ghalf3
4450 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
4451 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
4452 C Derivatives in DC(i+1)
4453 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
4454 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4455 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
4456 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4457 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
4458 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4459 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
4460 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4461 C Derivatives in DC(j)
4462 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
4463 & -3.0d0*vryg(k,2)*ury)!+ghalf1
4464 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4465 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4466 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4467 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4468 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4469 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4470 C Derivatives in DC(j+1) or DC(nres-1)
4471 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4472 & -3.0d0*vryg(k,3)*ury)
4473 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4474 & -3.0d0*vrzg(k,3)*ury)
4475 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4476 & -3.0d0*vryg(k,3)*urz)
4477 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4478 & -3.0d0*vrzg(k,3)*urz)
4479 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4481 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4494 aggi(k,l)=-aggi(k,l)
4495 aggi1(k,l)=-aggi1(k,l)
4496 aggj(k,l)=-aggj(k,l)
4497 aggj1(k,l)=-aggj1(k,l)
4500 if (j.lt.nres-1) then
4506 aggi(k,l)=-aggi(k,l)
4507 aggi1(k,l)=-aggi1(k,l)
4508 aggj(k,l)=-aggj(k,l)
4509 aggj1(k,l)=-aggj1(k,l)
4520 aggi(k,l)=-aggi(k,l)
4521 aggi1(k,l)=-aggi1(k,l)
4522 aggj(k,l)=-aggj(k,l)
4523 aggj1(k,l)=-aggj1(k,l)
4528 IF (wel_loc.gt.0.0d0) THEN
4529 C Contribution to the local-electrostatic energy coming from the i-j pair
4530 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4532 if (shield_mode.eq.0) then
4539 eel_loc_ij=eel_loc_ij
4540 & *fac_shield(i)*fac_shield(j)
4541 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4543 C Now derivative over eel_loc
4544 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4545 & (shield_mode.gt.0)) then
4548 do ilist=1,ishield_list(i)
4549 iresshield=shield_list(ilist,i)
4551 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
4554 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4556 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
4557 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4561 do ilist=1,ishield_list(j)
4562 iresshield=shield_list(ilist,j)
4564 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
4567 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4569 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
4570 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4577 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
4578 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4579 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
4580 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4581 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
4582 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4583 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
4584 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4589 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4590 c & ' eel_loc_ij',eel_loc_ij
4591 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4592 C Calculate patrial derivative for theta angle
4594 geel_loc_ij=(a22*gmuij1(1)
4598 & *fac_shield(i)*fac_shield(j)
4599 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4601 c write(iout,*) "derivative over thatai"
4602 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4604 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4605 & geel_loc_ij*wel_loc
4606 c write(iout,*) "derivative over thatai-1"
4607 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4614 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4615 & geel_loc_ij*wel_loc
4616 & *fac_shield(i)*fac_shield(j)
4617 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4620 c Derivative over j residue
4621 geel_loc_ji=a22*gmuji1(1)
4625 c write(iout,*) "derivative over thataj"
4626 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4629 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4630 & geel_loc_ji*wel_loc
4631 & *fac_shield(i)*fac_shield(j)
4632 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4639 c write(iout,*) "derivative over thataj-1"
4640 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4642 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4643 & geel_loc_ji*wel_loc
4644 & *fac_shield(i)*fac_shield(j)
4645 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4648 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4650 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4651 & 'eelloc',i,j,eel_loc_ij
4652 c if (eel_loc_ij.ne.0)
4653 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4654 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4656 eel_loc=eel_loc+eel_loc_ij
4657 C Partial derivatives in virtual-bond dihedral angles gamma
4659 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4660 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4661 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
4662 & *fac_shield(i)*fac_shield(j)
4663 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4665 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4666 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4667 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
4668 & *fac_shield(i)*fac_shield(j)
4669 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4671 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4673 ggg(l)=(agg(l,1)*muij(1)+
4674 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
4675 & *fac_shield(i)*fac_shield(j)
4676 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4678 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4679 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4680 cgrad ghalf=0.5d0*ggg(l)
4681 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4682 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4684 gel_loc_long(3,j)=gel_loc_long(3,j)+
4685 & ssgradlipj*eel_loc_ij/2.0d0*lipscale/
4686 & ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4688 gel_loc_long(3,i)=gel_loc_long(3,i)+
4689 & ssgradlipi*eel_loc_ij/2.0d0*lipscale/
4690 & ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4694 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4697 C Remaining derivatives of eello
4699 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4700 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4701 & *fac_shield(i)*fac_shield(j)
4702 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4704 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4705 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4706 & *fac_shield(i)*fac_shield(j)
4707 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4709 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4710 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4711 & *fac_shield(i)*fac_shield(j)
4712 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4714 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4715 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4716 & *fac_shield(i)*fac_shield(j)
4717 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4721 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4722 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4723 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4724 & .and. num_conti.le.maxconts) then
4725 c write (iout,*) i,j," entered corr"
4727 C Calculate the contact function. The ith column of the array JCONT will
4728 C contain the numbers of atoms that make contacts with the atom I (of numbers
4729 C greater than I). The arrays FACONT and GACONT will contain the values of
4730 C the contact function and its derivative.
4731 c r0ij=1.02D0*rpp(iteli,itelj)
4732 c r0ij=1.11D0*rpp(iteli,itelj)
4733 r0ij=2.20D0*rpp(iteli,itelj)
4734 c r0ij=1.55D0*rpp(iteli,itelj)
4735 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4736 if (fcont.gt.0.0D0) then
4737 num_conti=num_conti+1
4738 if (num_conti.gt.maxconts) then
4739 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4740 & ' will skip next contacts for this conf.'
4742 jcont_hb(num_conti,i)=j
4743 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4744 cd & " jcont_hb",jcont_hb(num_conti,i)
4745 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4746 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4747 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4749 d_cont(num_conti,i)=rij
4750 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4751 C --- Electrostatic-interaction matrix ---
4752 a_chuj(1,1,num_conti,i)=a22
4753 a_chuj(1,2,num_conti,i)=a23
4754 a_chuj(2,1,num_conti,i)=a32
4755 a_chuj(2,2,num_conti,i)=a33
4756 C --- Gradient of rij
4758 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4765 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4766 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4767 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4768 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4769 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4774 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4775 C Calculate contact energies
4777 wij=cosa-3.0D0*cosb*cosg
4780 c fac3=dsqrt(-ael6i)/r0ij**3
4781 fac3=dsqrt(-ael6i)*r3ij
4782 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4783 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4784 if (ees0tmp.gt.0) then
4785 ees0pij=dsqrt(ees0tmp)
4789 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4790 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4791 if (ees0tmp.gt.0) then
4792 ees0mij=dsqrt(ees0tmp)
4797 if (shield_mode.eq.0) then
4801 ees0plist(num_conti,i)=j
4802 C fac_shield(i)=0.4d0
4803 C fac_shield(j)=0.6d0
4805 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4806 & *fac_shield(i)*fac_shield(j)
4807 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4808 & *fac_shield(i)*fac_shield(j)
4809 C Diagnostics. Comment out or remove after debugging!
4810 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4811 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4812 c ees0m(num_conti,i)=0.0D0
4814 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4815 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4816 C Angular derivatives of the contact function
4817 ees0pij1=fac3/ees0pij
4818 ees0mij1=fac3/ees0mij
4819 fac3p=-3.0D0*fac3*rrmij
4820 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4821 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4823 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4824 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4825 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4826 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4827 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4828 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4829 ecosap=ecosa1+ecosa2
4830 ecosbp=ecosb1+ecosb2
4831 ecosgp=ecosg1+ecosg2
4832 ecosam=ecosa1-ecosa2
4833 ecosbm=ecosb1-ecosb2
4834 ecosgm=ecosg1-ecosg2
4843 facont_hb(num_conti,i)=fcont
4844 fprimcont=fprimcont/rij
4845 cd facont_hb(num_conti,i)=1.0D0
4846 C Following line is for diagnostics.
4849 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4850 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4853 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4854 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4856 gggp(1)=gggp(1)+ees0pijp*xj
4857 gggp(2)=gggp(2)+ees0pijp*yj
4858 gggp(3)=gggp(3)+ees0pijp*zj
4859 gggm(1)=gggm(1)+ees0mijp*xj
4860 gggm(2)=gggm(2)+ees0mijp*yj
4861 gggm(3)=gggm(3)+ees0mijp*zj
4862 C Derivatives due to the contact function
4863 gacont_hbr(1,num_conti,i)=fprimcont*xj
4864 gacont_hbr(2,num_conti,i)=fprimcont*yj
4865 gacont_hbr(3,num_conti,i)=fprimcont*zj
4868 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4869 c following the change of gradient-summation algorithm.
4871 cgrad ghalfp=0.5D0*gggp(k)
4872 cgrad ghalfm=0.5D0*gggm(k)
4873 gacontp_hb1(k,num_conti,i)=!ghalfp
4874 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4875 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4876 & *fac_shield(i)*fac_shield(j)
4878 gacontp_hb2(k,num_conti,i)=!ghalfp
4879 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4880 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4881 & *fac_shield(i)*fac_shield(j)
4883 gacontp_hb3(k,num_conti,i)=gggp(k)
4884 & *fac_shield(i)*fac_shield(j)
4886 gacontm_hb1(k,num_conti,i)=!ghalfm
4887 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4888 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4889 & *fac_shield(i)*fac_shield(j)
4891 gacontm_hb2(k,num_conti,i)=!ghalfm
4892 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4893 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4894 & *fac_shield(i)*fac_shield(j)
4896 gacontm_hb3(k,num_conti,i)=gggm(k)
4897 & *fac_shield(i)*fac_shield(j)
4900 C Diagnostics. Comment out or remove after debugging!
4902 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4903 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4904 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4905 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4906 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4907 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4910 endif ! num_conti.le.maxconts
4913 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4916 ghalf=0.5d0*agg(l,k)
4917 aggi(l,k)=aggi(l,k)+ghalf
4918 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4919 aggj(l,k)=aggj(l,k)+ghalf
4922 if (j.eq.nres-1 .and. i.lt.j-2) then
4925 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4930 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4933 C-----------------------------------------------------------------------------
4934 subroutine eturn3(i,eello_turn3)
4935 C Third- and fourth-order contributions from turns
4936 implicit real*8 (a-h,o-z)
4937 include 'DIMENSIONS'
4938 include 'COMMON.IOUNITS'
4939 include 'COMMON.GEO'
4940 include 'COMMON.VAR'
4941 include 'COMMON.LOCAL'
4942 include 'COMMON.CHAIN'
4943 include 'COMMON.DERIV'
4944 include 'COMMON.INTERACT'
4945 include 'COMMON.CONTACTS'
4946 include 'COMMON.TORSION'
4947 include 'COMMON.VECTORS'
4948 include 'COMMON.FFIELD'
4949 include 'COMMON.CONTROL'
4950 include 'COMMON.SHIELD'
4952 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4953 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4954 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4955 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4956 & auxgmat2(2,2),auxgmatt2(2,2)
4957 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4958 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4959 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4960 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4963 C xj=(c(1,j)+c(1,j+1))/2.0d0
4964 C yj=(c(2,j)+c(2,j+1))/2.0d0
4965 zj=(c(3,j)+c(3,j+1))/2.0d0
4966 C xj=mod(xj,boxxsize)
4967 C if (xj.lt.0) xj=xj+boxxsize
4968 C yj=mod(yj,boxysize)
4969 C if (yj.lt.0) yj=yj+boxysize
4971 if (zj.lt.0) zj=zj+boxzsize
4972 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
4973 if ((zj.gt.bordlipbot)
4974 &.and.(zj.lt.bordliptop)) then
4975 C the energy transfer exist
4976 if (zj.lt.buflipbot) then
4977 C what fraction I am in
4979 & ((zj-bordlipbot)/lipbufthick)
4980 C lipbufthick is thickenes of lipid buffore
4981 sslipj=sscalelip(fracinbuf)
4982 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4983 elseif (zj.gt.bufliptop) then
4984 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4985 sslipj=sscalelip(fracinbuf)
4986 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4998 C write (iout,*) "eturn3",i,j,j1,j2
5003 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5005 C Third-order contributions
5012 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5013 cd call checkint_turn3(i,a_temp,eello_turn3_num)
5014 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
5015 c auxalary matices for theta gradient
5016 c auxalary matrix for i+1 and constant i+2
5017 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
5018 c auxalary matrix for i+2 and constant i+1
5019 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
5020 call transpose2(auxmat(1,1),auxmat1(1,1))
5021 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
5022 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
5023 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5024 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
5025 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
5026 if (shield_mode.eq.0) then
5034 C & write(iout,*) i,j,fac_shield(i),fac_shield(j)
5035 eello_turn3=eello_turn3+
5036 C & 1.0*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5037 &0.5d0*(pizda(1,1)+pizda(2,2))
5038 & *fac_shield(i)*fac_shield(j)
5039 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5041 &0.5d0*(pizda(1,1)+pizda(2,2))
5042 & *fac_shield(i)*fac_shield(j)
5044 C Derivatives in theta
5045 gloc(nphi+i,icg)=gloc(nphi+i,icg)
5046 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
5047 & *fac_shield(i)*fac_shield(j)
5048 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5050 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
5051 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
5052 & *fac_shield(i)*fac_shield(j)
5053 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5057 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5058 C Derivatives in shield mode
5059 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
5060 & (shield_mode.gt.0)) then
5063 do ilist=1,ishield_list(i)
5064 iresshield=shield_list(ilist,i)
5066 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
5068 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
5070 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
5071 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
5075 do ilist=1,ishield_list(j)
5076 iresshield=shield_list(ilist,j)
5078 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
5080 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
5082 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
5083 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
5090 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
5091 & grad_shield(k,i)*eello_t3/fac_shield(i)
5092 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
5093 & grad_shield(k,j)*eello_t3/fac_shield(j)
5094 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
5095 & grad_shield(k,i)*eello_t3/fac_shield(i)
5096 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
5097 & grad_shield(k,j)*eello_t3/fac_shield(j)
5101 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5102 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
5103 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
5104 cd & ' eello_turn3_num',4*eello_turn3_num
5105 C Derivatives in gamma(i)
5106 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
5107 call transpose2(auxmat2(1,1),auxmat3(1,1))
5108 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
5109 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
5110 & *fac_shield(i)*fac_shield(j)
5111 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5113 C Derivatives in gamma(i+1)
5114 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
5115 call transpose2(auxmat2(1,1),auxmat3(1,1))
5116 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
5117 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
5118 & +0.5d0*(pizda(1,1)+pizda(2,2))
5119 & *fac_shield(i)*fac_shield(j)
5120 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5122 C Cartesian derivatives
5124 c ghalf1=0.5d0*agg(l,1)
5125 c ghalf2=0.5d0*agg(l,2)
5126 c ghalf3=0.5d0*agg(l,3)
5127 c ghalf4=0.5d0*agg(l,4)
5128 a_temp(1,1)=aggi(l,1)!+ghalf1
5129 a_temp(1,2)=aggi(l,2)!+ghalf2
5130 a_temp(2,1)=aggi(l,3)!+ghalf3
5131 a_temp(2,2)=aggi(l,4)!+ghalf4
5132 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5133 gcorr3_turn(l,i)=gcorr3_turn(l,i)
5134 & +0.5d0*(pizda(1,1)+pizda(2,2))
5135 & *fac_shield(i)*fac_shield(j)
5136 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5138 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
5139 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
5140 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
5141 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
5142 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5143 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
5144 & +0.5d0*(pizda(1,1)+pizda(2,2))
5145 & *fac_shield(i)*fac_shield(j)
5146 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5147 a_temp(1,1)=aggj(l,1)!+ghalf1
5148 a_temp(1,2)=aggj(l,2)!+ghalf2
5149 a_temp(2,1)=aggj(l,3)!+ghalf3
5150 a_temp(2,2)=aggj(l,4)!+ghalf4
5151 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5152 gcorr3_turn(l,j)=gcorr3_turn(l,j)
5153 & +0.5d0*(pizda(1,1)+pizda(2,2))
5154 & *fac_shield(i)*fac_shield(j)
5155 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5157 a_temp(1,1)=aggj1(l,1)
5158 a_temp(1,2)=aggj1(l,2)
5159 a_temp(2,1)=aggj1(l,3)
5160 a_temp(2,2)=aggj1(l,4)
5161 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5162 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
5163 & +0.5d0*(pizda(1,1)+pizda(2,2))
5164 & *fac_shield(i)*fac_shield(j)
5165 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5167 gshieldc_t3(3,i)=gshieldc_t3(3,i)+
5168 & ssgradlipi*eello_t3/4.0d0*lipscale
5169 gshieldc_t3(3,j)=gshieldc_t3(3,j)+
5170 & ssgradlipj*eello_t3/4.0d0*lipscale
5171 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+
5172 & ssgradlipi*eello_t3/4.0d0*lipscale
5173 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+
5174 & ssgradlipj*eello_t3/4.0d0*lipscale
5176 C print *,ssgradlipi,ssgradlipj,eello_t3,sslipi,sslipj
5179 C-------------------------------------------------------------------------------
5180 subroutine eturn4(i,eello_turn4)
5181 C Third- and fourth-order contributions from turns
5182 implicit real*8 (a-h,o-z)
5183 include 'DIMENSIONS'
5184 include 'COMMON.IOUNITS'
5185 include 'COMMON.GEO'
5186 include 'COMMON.VAR'
5187 include 'COMMON.LOCAL'
5188 include 'COMMON.CHAIN'
5189 include 'COMMON.DERIV'
5190 include 'COMMON.INTERACT'
5191 include 'COMMON.CONTACTS'
5192 include 'COMMON.TORSION'
5193 include 'COMMON.VECTORS'
5194 include 'COMMON.FFIELD'
5195 include 'COMMON.CONTROL'
5196 include 'COMMON.SHIELD'
5198 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
5199 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
5200 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
5201 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
5202 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
5203 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
5204 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
5205 double precision agg(3,4),aggi(3,4),aggi1(3,4),
5206 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
5207 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
5208 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
5211 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5213 C Fourth-order contributions
5221 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5222 cd call checkint_turn4(i,a_temp,eello_turn4_num)
5223 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
5224 c write(iout,*)"WCHODZE W PROGRAM"
5225 zj=(c(3,j)+c(3,j+1))/2.0d0
5226 C xj=mod(xj,boxxsize)
5227 C if (xj.lt.0) xj=xj+boxxsize
5228 C yj=mod(yj,boxysize)
5229 C if (yj.lt.0) yj=yj+boxysize
5231 if (zj.lt.0) zj=zj+boxzsize
5232 C if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
5233 if ((zj.gt.bordlipbot)
5234 &.and.(zj.lt.bordliptop)) then
5235 C the energy transfer exist
5236 if (zj.lt.buflipbot) then
5237 C what fraction I am in
5239 & ((zj-bordlipbot)/lipbufthick)
5240 C lipbufthick is thickenes of lipid buffore
5241 sslipj=sscalelip(fracinbuf)
5242 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
5243 elseif (zj.gt.bufliptop) then
5244 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
5245 sslipj=sscalelip(fracinbuf)
5246 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
5260 iti1=itype2loc(itype(i+1))
5261 iti2=itype2loc(itype(i+2))
5262 iti3=itype2loc(itype(i+3))
5263 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
5264 call transpose2(EUg(1,1,i+1),e1t(1,1))
5265 call transpose2(Eug(1,1,i+2),e2t(1,1))
5266 call transpose2(Eug(1,1,i+3),e3t(1,1))
5267 C Ematrix derivative in theta
5268 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
5269 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
5270 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
5271 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5272 c eta1 in derivative theta
5273 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
5274 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5275 c auxgvec is derivative of Ub2 so i+3 theta
5276 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
5277 c auxalary matrix of E i+1
5278 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
5281 s1=scalar2(b1(1,i+2),auxvec(1))
5282 c derivative of theta i+2 with constant i+3
5283 gs23=scalar2(gtb1(1,i+2),auxvec(1))
5284 c derivative of theta i+2 with constant i+2
5285 gs32=scalar2(b1(1,i+2),auxgvec(1))
5286 c derivative of E matix in theta of i+1
5287 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
5289 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5290 c ea31 in derivative theta
5291 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
5292 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5293 c auxilary matrix auxgvec of Ub2 with constant E matirx
5294 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
5295 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
5296 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
5300 s2=scalar2(b1(1,i+1),auxvec(1))
5301 c derivative of theta i+1 with constant i+3
5302 gs13=scalar2(gtb1(1,i+1),auxvec(1))
5303 c derivative of theta i+2 with constant i+1
5304 gs21=scalar2(b1(1,i+1),auxgvec(1))
5305 c derivative of theta i+3 with constant i+1
5306 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
5307 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
5309 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5310 c two derivatives over diffetent matrices
5311 c gtae3e2 is derivative over i+3
5312 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
5313 c ae3gte2 is derivative over i+2
5314 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
5315 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5316 c three possible derivative over theta E matices
5318 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
5320 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
5322 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
5323 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5325 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
5326 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
5327 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
5328 if (shield_mode.eq.0) then
5335 eello_turn4=eello_turn4-(s1+s2+s3)
5336 & *fac_shield(i)*fac_shield(j)
5337 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5339 eello_t4=-(s1+s2+s3)
5340 & *fac_shield(i)*fac_shield(j)
5341 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
5342 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
5343 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
5344 C Now derivative over shield:
5345 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
5346 & (shield_mode.gt.0)) then
5349 do ilist=1,ishield_list(i)
5350 iresshield=shield_list(ilist,i)
5352 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
5354 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
5356 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
5357 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
5361 do ilist=1,ishield_list(j)
5362 iresshield=shield_list(ilist,j)
5364 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
5366 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
5368 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
5369 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
5376 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
5377 & grad_shield(k,i)*eello_t4/fac_shield(i)
5378 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
5379 & grad_shield(k,j)*eello_t4/fac_shield(j)
5380 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
5381 & grad_shield(k,i)*eello_t4/fac_shield(i)
5382 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
5383 & grad_shield(k,j)*eello_t4/fac_shield(j)
5392 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5393 cd & ' eello_turn4_num',8*eello_turn4_num
5395 gloc(nphi+i,icg)=gloc(nphi+i,icg)
5396 & -(gs13+gsE13+gsEE1)*wturn4
5397 & *fac_shield(i)*fac_shield(j)
5398 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5400 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
5401 & -(gs23+gs21+gsEE2)*wturn4
5402 & *fac_shield(i)*fac_shield(j)
5403 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5405 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
5406 & -(gs32+gsE31+gsEE3)*wturn4
5407 & *fac_shield(i)*fac_shield(j)
5408 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5410 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
5413 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5414 & 'eturn4',i,j,-(s1+s2+s3)
5415 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5416 c & ' eello_turn4_num',8*eello_turn4_num
5417 C Derivatives in gamma(i)
5418 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
5419 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
5420 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
5421 s1=scalar2(b1(1,i+2),auxvec(1))
5422 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
5423 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5424 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
5425 & *fac_shield(i)*fac_shield(j)
5426 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5428 C Derivatives in gamma(i+1)
5429 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
5430 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
5431 s2=scalar2(b1(1,i+1),auxvec(1))
5432 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5433 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5434 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5435 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
5436 & *fac_shield(i)*fac_shield(j)
5437 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5439 C Derivatives in gamma(i+2)
5440 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5441 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5442 s1=scalar2(b1(1,i+2),auxvec(1))
5443 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5444 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5445 s2=scalar2(b1(1,i+1),auxvec(1))
5446 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5447 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5448 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5449 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
5450 & *fac_shield(i)*fac_shield(j)
5451 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5453 C Cartesian derivatives
5454 C Derivatives of this turn contributions in DC(i+2)
5455 if (j.lt.nres-1) then
5457 a_temp(1,1)=agg(l,1)
5458 a_temp(1,2)=agg(l,2)
5459 a_temp(2,1)=agg(l,3)
5460 a_temp(2,2)=agg(l,4)
5461 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5462 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5463 s1=scalar2(b1(1,i+2),auxvec(1))
5464 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5465 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5466 s2=scalar2(b1(1,i+1),auxvec(1))
5467 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5468 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5469 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5471 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
5472 & *fac_shield(i)*fac_shield(j)
5473 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5477 C Remaining derivatives of this turn contribution
5479 a_temp(1,1)=aggi(l,1)
5480 a_temp(1,2)=aggi(l,2)
5481 a_temp(2,1)=aggi(l,3)
5482 a_temp(2,2)=aggi(l,4)
5483 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5484 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5485 s1=scalar2(b1(1,i+2),auxvec(1))
5486 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5487 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5488 s2=scalar2(b1(1,i+1),auxvec(1))
5489 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5490 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5491 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5492 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
5493 & *fac_shield(i)*fac_shield(j)
5494 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5496 a_temp(1,1)=aggi1(l,1)
5497 a_temp(1,2)=aggi1(l,2)
5498 a_temp(2,1)=aggi1(l,3)
5499 a_temp(2,2)=aggi1(l,4)
5500 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5501 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5502 s1=scalar2(b1(1,i+2),auxvec(1))
5503 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5504 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5505 s2=scalar2(b1(1,i+1),auxvec(1))
5506 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5507 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5508 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5509 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
5510 & *fac_shield(i)*fac_shield(j)
5511 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5513 a_temp(1,1)=aggj(l,1)
5514 a_temp(1,2)=aggj(l,2)
5515 a_temp(2,1)=aggj(l,3)
5516 a_temp(2,2)=aggj(l,4)
5517 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5518 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5519 s1=scalar2(b1(1,i+2),auxvec(1))
5520 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5521 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5522 s2=scalar2(b1(1,i+1),auxvec(1))
5523 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5524 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5525 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5526 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
5527 & *fac_shield(i)*fac_shield(j)
5528 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5530 a_temp(1,1)=aggj1(l,1)
5531 a_temp(1,2)=aggj1(l,2)
5532 a_temp(2,1)=aggj1(l,3)
5533 a_temp(2,2)=aggj1(l,4)
5534 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5535 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5536 s1=scalar2(b1(1,i+2),auxvec(1))
5537 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5538 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5539 s2=scalar2(b1(1,i+1),auxvec(1))
5540 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5541 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5542 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5543 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5544 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
5545 & *fac_shield(i)*fac_shield(j)
5546 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5548 gshieldc_t4(3,i)=gshieldc_t4(3,i)+
5549 & ssgradlipi*eello_t4/4.0d0*lipscale
5550 gshieldc_t4(3,j)=gshieldc_t4(3,j)+
5551 & ssgradlipj*eello_t4/4.0d0*lipscale
5552 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+
5553 & ssgradlipi*eello_t4/4.0d0*lipscale
5554 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+
5555 & ssgradlipj*eello_t4/4.0d0*lipscale
5558 C-----------------------------------------------------------------------------
5559 subroutine vecpr(u,v,w)
5560 implicit real*8(a-h,o-z)
5561 dimension u(3),v(3),w(3)
5562 w(1)=u(2)*v(3)-u(3)*v(2)
5563 w(2)=-u(1)*v(3)+u(3)*v(1)
5564 w(3)=u(1)*v(2)-u(2)*v(1)
5567 C-----------------------------------------------------------------------------
5568 subroutine unormderiv(u,ugrad,unorm,ungrad)
5569 C This subroutine computes the derivatives of a normalized vector u, given
5570 C the derivatives computed without normalization conditions, ugrad. Returns
5573 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
5574 double precision vec(3)
5575 double precision scalar
5577 c write (2,*) 'ugrad',ugrad
5580 vec(i)=scalar(ugrad(1,i),u(1))
5582 c write (2,*) 'vec',vec
5585 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5588 c write (2,*) 'ungrad',ungrad
5591 C-----------------------------------------------------------------------------
5592 subroutine escp_soft_sphere(evdw2,evdw2_14)
5594 C This subroutine calculates the excluded-volume interaction energy between
5595 C peptide-group centers and side chains and its gradient in virtual-bond and
5596 C side-chain vectors.
5598 implicit real*8 (a-h,o-z)
5599 include 'DIMENSIONS'
5600 include 'COMMON.GEO'
5601 include 'COMMON.VAR'
5602 include 'COMMON.LOCAL'
5603 include 'COMMON.CHAIN'
5604 include 'COMMON.DERIV'
5605 include 'COMMON.INTERACT'
5606 include 'COMMON.FFIELD'
5607 include 'COMMON.IOUNITS'
5608 include 'COMMON.CONTROL'
5613 cd print '(a)','Enter ESCP'
5614 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5618 do i=iatscp_s,iatscp_e
5619 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5621 xi=0.5D0*(c(1,i)+c(1,i+1))
5622 yi=0.5D0*(c(2,i)+c(2,i+1))
5623 zi=0.5D0*(c(3,i)+c(3,i+1))
5624 C Return atom into box, boxxsize is size of box in x dimension
5626 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5627 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5628 C Condition for being inside the proper box
5629 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5630 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5634 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5635 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5636 C Condition for being inside the proper box
5637 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5638 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5642 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5643 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5644 cC Condition for being inside the proper box
5645 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5646 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5650 if (xi.lt.0) xi=xi+boxxsize
5652 if (yi.lt.0) yi=yi+boxysize
5654 if (zi.lt.0) zi=zi+boxzsize
5655 C xi=xi+xshift*boxxsize
5656 C yi=yi+yshift*boxysize
5657 C zi=zi+zshift*boxzsize
5658 do iint=1,nscp_gr(i)
5660 do j=iscpstart(i,iint),iscpend(i,iint)
5661 if (itype(j).eq.ntyp1) cycle
5662 itypj=iabs(itype(j))
5663 C Uncomment following three lines for SC-p interactions
5667 C Uncomment following three lines for Ca-p interactions
5672 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5673 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5674 C Condition for being inside the proper box
5675 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5676 c & (xj.lt.((-0.5d0)*boxxsize))) then
5680 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5681 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5682 cC Condition for being inside the proper box
5683 c if ((yj.gt.((0.5d0)*boxysize)).or.
5684 c & (yj.lt.((-0.5d0)*boxysize))) then
5688 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5689 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5690 C Condition for being inside the proper box
5691 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5692 c & (zj.lt.((-0.5d0)*boxzsize))) then
5695 if (xj.lt.0) xj=xj+boxxsize
5697 if (yj.lt.0) yj=yj+boxysize
5699 if (zj.lt.0) zj=zj+boxzsize
5700 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5708 xj=xj_safe+xshift*boxxsize
5709 yj=yj_safe+yshift*boxysize
5710 zj=zj_safe+zshift*boxzsize
5711 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5712 if(dist_temp.lt.dist_init) then
5722 if (subchap.eq.1) then
5735 rij=xj*xj+yj*yj+zj*zj
5739 if (rij.lt.r0ijsq) then
5740 evdwij=0.25d0*(rij-r0ijsq)**2
5748 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5753 cgrad if (j.lt.i) then
5754 cd write (iout,*) 'j<i'
5755 C Uncomment following three lines for SC-p interactions
5757 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5760 cd write (iout,*) 'j>i'
5762 cgrad ggg(k)=-ggg(k)
5763 C Uncomment following line for SC-p interactions
5764 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5768 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5770 cgrad kstart=min0(i+1,j)
5771 cgrad kend=max0(i-1,j-1)
5772 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5773 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5774 cgrad do k=kstart,kend
5776 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5780 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5781 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5792 C-----------------------------------------------------------------------------
5793 subroutine escp(evdw2,evdw2_14)
5795 C This subroutine calculates the excluded-volume interaction energy between
5796 C peptide-group centers and side chains and its gradient in virtual-bond and
5797 C side-chain vectors.
5799 implicit real*8 (a-h,o-z)
5800 include 'DIMENSIONS'
5801 include 'COMMON.GEO'
5802 include 'COMMON.VAR'
5803 include 'COMMON.LOCAL'
5804 include 'COMMON.CHAIN'
5805 include 'COMMON.DERIV'
5806 include 'COMMON.INTERACT'
5807 include 'COMMON.FFIELD'
5808 include 'COMMON.IOUNITS'
5809 include 'COMMON.CONTROL'
5810 include 'COMMON.SPLITELE'
5814 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
5815 cd print '(a)','Enter ESCP'
5816 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5820 do i=iatscp_s,iatscp_e
5821 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5823 xi=0.5D0*(c(1,i)+c(1,i+1))
5824 yi=0.5D0*(c(2,i)+c(2,i+1))
5825 zi=0.5D0*(c(3,i)+c(3,i+1))
5827 if (xi.lt.0) xi=xi+boxxsize
5829 if (yi.lt.0) yi=yi+boxysize
5831 if (zi.lt.0) zi=zi+boxzsize
5832 c xi=xi+xshift*boxxsize
5833 c yi=yi+yshift*boxysize
5834 c zi=zi+zshift*boxzsize
5835 c print *,xi,yi,zi,'polozenie i'
5836 C Return atom into box, boxxsize is size of box in x dimension
5838 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
5839 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
5840 C Condition for being inside the proper box
5841 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
5842 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
5846 c print *,xi,boxxsize,"pierwszy"
5848 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
5849 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
5850 C Condition for being inside the proper box
5851 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
5852 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
5856 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
5857 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
5858 C Condition for being inside the proper box
5859 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
5860 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
5863 do iint=1,nscp_gr(i)
5865 do j=iscpstart(i,iint),iscpend(i,iint)
5866 itypj=iabs(itype(j))
5867 if (itypj.eq.ntyp1) cycle
5868 C Uncomment following three lines for SC-p interactions
5872 C Uncomment following three lines for Ca-p interactions
5877 if (xj.lt.0) xj=xj+boxxsize
5879 if (yj.lt.0) yj=yj+boxysize
5881 if (zj.lt.0) zj=zj+boxzsize
5883 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5884 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5885 C Condition for being inside the proper box
5886 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5887 c & (xj.lt.((-0.5d0)*boxxsize))) then
5891 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5892 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5893 cC Condition for being inside the proper box
5894 c if ((yj.gt.((0.5d0)*boxysize)).or.
5895 c & (yj.lt.((-0.5d0)*boxysize))) then
5899 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5900 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5901 C Condition for being inside the proper box
5902 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5903 c & (zj.lt.((-0.5d0)*boxzsize))) then
5906 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5907 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5915 xj=xj_safe+xshift*boxxsize
5916 yj=yj_safe+yshift*boxysize
5917 zj=zj_safe+zshift*boxzsize
5918 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5919 if(dist_temp.lt.dist_init) then
5929 if (subchap.eq.1) then
5938 c print *,xj,yj,zj,'polozenie j'
5939 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5941 sss=sscale(1.0d0/(dsqrt(rrij)))
5942 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5943 c if (sss.eq.0) print *,'czasem jest OK'
5944 if (sss.le.0.0d0) cycle
5945 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5947 e1=fac*fac*aad(itypj,iteli)
5948 e2=fac*bad(itypj,iteli)
5949 if (iabs(j-i) .le. 2) then
5952 evdw2_14=evdw2_14+(e1+e2)*sss
5955 evdw2=evdw2+evdwij*sss
5956 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5957 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5960 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5962 fac=-(evdwij+e1)*rrij*sss
5963 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5967 cgrad if (j.lt.i) then
5968 cd write (iout,*) 'j<i'
5969 C Uncomment following three lines for SC-p interactions
5971 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5974 cd write (iout,*) 'j>i'
5976 cgrad ggg(k)=-ggg(k)
5977 C Uncomment following line for SC-p interactions
5978 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5979 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5983 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5985 cgrad kstart=min0(i+1,j)
5986 cgrad kend=max0(i-1,j-1)
5987 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5988 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5989 cgrad do k=kstart,kend
5991 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5995 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5996 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5998 c endif !endif for sscale cutoff
6008 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
6009 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
6010 gradx_scp(j,i)=expon*gradx_scp(j,i)
6013 C******************************************************************************
6017 C To save time the factor EXPON has been extracted from ALL components
6018 C of GVDWC and GRADX. Remember to multiply them by this factor before further
6021 C******************************************************************************
6024 C--------------------------------------------------------------------------
6025 subroutine edis(ehpb)
6027 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
6029 implicit real*8 (a-h,o-z)
6030 include 'DIMENSIONS'
6031 include 'COMMON.SBRIDGE'
6032 include 'COMMON.CHAIN'
6033 include 'COMMON.DERIV'
6034 include 'COMMON.VAR'
6035 include 'COMMON.INTERACT'
6036 include 'COMMON.IOUNITS'
6037 include 'COMMON.CONTROL'
6043 C write (iout,*) ,"link_end",link_end,constr_dist
6044 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
6045 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
6046 if (link_end.eq.0) return
6047 do i=link_start,link_end
6048 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
6049 C CA-CA distance used in regularization of structure.
6052 C iii and jjj point to the residues for which the distance is assigned.
6053 if (ii.gt.nres) then
6060 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
6061 c & dhpb(i),dhpb1(i),forcon(i)
6062 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
6063 C distance and angle dependent SS bond potential.
6064 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
6065 C & iabs(itype(jjj)).eq.1) then
6066 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
6067 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
6068 if (.not.dyn_ss .and. i.le.nss) then
6069 C 15/02/13 CC dynamic SSbond - additional check
6070 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
6071 & iabs(itype(jjj)).eq.1) then
6072 call ssbond_ene(iii,jjj,eij)
6075 cd write (iout,*) "eij",eij
6076 cd & ' waga=',waga,' fac=',fac
6077 else if (ii.gt.nres .and. jj.gt.nres) then
6078 c Restraints from contact prediction
6080 if (constr_dist.eq.11) then
6081 ehpb=ehpb+fordepth(i)**4.0d0
6082 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
6083 fac=fordepth(i)**4.0d0
6084 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
6085 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
6086 & ehpb,fordepth(i),dd
6088 if (dhpb1(i).gt.0.0d0) then
6089 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6090 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
6091 c write (iout,*) "beta nmr",
6092 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6096 C Get the force constant corresponding to this distance.
6098 C Calculate the contribution to energy.
6099 ehpb=ehpb+waga*rdis*rdis
6100 c write (iout,*) "beta reg",dd,waga*rdis*rdis
6102 C Evaluate gradient.
6108 ggg(j)=fac*(c(j,jj)-c(j,ii))
6111 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
6112 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
6115 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
6116 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
6119 C Calculate the distance between the two points and its difference from the
6122 if (constr_dist.eq.11) then
6123 ehpb=ehpb+fordepth(i)**4.0d0
6124 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
6125 fac=fordepth(i)**4.0d0
6126 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
6127 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
6128 & ehpb,fordepth(i),dd
6130 if (dhpb1(i).gt.0.0d0) then
6131 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6132 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
6133 c write (iout,*) "alph nmr",
6134 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6137 C Get the force constant corresponding to this distance.
6139 C Calculate the contribution to energy.
6140 ehpb=ehpb+waga*rdis*rdis
6141 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
6143 C Evaluate gradient.
6149 ggg(j)=fac*(c(j,jj)-c(j,ii))
6151 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
6152 C If this is a SC-SC distance, we need to calculate the contributions to the
6153 C Cartesian gradient in the SC vectors (ghpbx).
6156 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
6157 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
6160 cgrad do j=iii,jjj-1
6162 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
6166 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
6167 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
6171 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
6174 C--------------------------------------------------------------------------
6175 subroutine ssbond_ene(i,j,eij)
6177 C Calculate the distance and angle dependent SS-bond potential energy
6178 C using a free-energy function derived based on RHF/6-31G** ab initio
6179 C calculations of diethyl disulfide.
6181 C A. Liwo and U. Kozlowska, 11/24/03
6183 implicit real*8 (a-h,o-z)
6184 include 'DIMENSIONS'
6185 include 'COMMON.SBRIDGE'
6186 include 'COMMON.CHAIN'
6187 include 'COMMON.DERIV'
6188 include 'COMMON.LOCAL'
6189 include 'COMMON.INTERACT'
6190 include 'COMMON.VAR'
6191 include 'COMMON.IOUNITS'
6192 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
6193 itypi=iabs(itype(i))
6197 dxi=dc_norm(1,nres+i)
6198 dyi=dc_norm(2,nres+i)
6199 dzi=dc_norm(3,nres+i)
6200 c dsci_inv=dsc_inv(itypi)
6201 dsci_inv=vbld_inv(nres+i)
6202 itypj=iabs(itype(j))
6203 c dscj_inv=dsc_inv(itypj)
6204 dscj_inv=vbld_inv(nres+j)
6208 dxj=dc_norm(1,nres+j)
6209 dyj=dc_norm(2,nres+j)
6210 dzj=dc_norm(3,nres+j)
6211 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
6216 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
6217 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
6218 om12=dxi*dxj+dyi*dyj+dzi*dzj
6220 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
6221 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
6227 deltat12=om2-om1+2.0d0
6229 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
6230 & +akct*deltad*deltat12
6231 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
6232 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
6233 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
6234 c & " deltat12",deltat12," eij",eij
6235 ed=2*akcm*deltad+akct*deltat12
6237 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
6238 eom1=-2*akth*deltat1-pom1-om2*pom2
6239 eom2= 2*akth*deltat2+pom1-om1*pom2
6242 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
6243 ghpbx(k,i)=ghpbx(k,i)-ggk
6244 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
6245 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
6246 ghpbx(k,j)=ghpbx(k,j)+ggk
6247 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
6248 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
6249 ghpbc(k,i)=ghpbc(k,i)-ggk
6250 ghpbc(k,j)=ghpbc(k,j)+ggk
6253 C Calculate the components of the gradient in DC and X
6257 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
6262 C--------------------------------------------------------------------------
6263 subroutine ebond(estr)
6265 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
6267 implicit real*8 (a-h,o-z)
6268 include 'DIMENSIONS'
6269 include 'COMMON.LOCAL'
6270 include 'COMMON.GEO'
6271 include 'COMMON.INTERACT'
6272 include 'COMMON.DERIV'
6273 include 'COMMON.VAR'
6274 include 'COMMON.CHAIN'
6275 include 'COMMON.IOUNITS'
6276 include 'COMMON.NAMES'
6277 include 'COMMON.FFIELD'
6278 include 'COMMON.CONTROL'
6279 include 'COMMON.SETUP'
6280 double precision u(3),ud(3)
6283 do i=ibondp_start,ibondp_end
6284 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
6285 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
6287 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
6288 c & *dc(j,i-1)/vbld(i)
6290 c if (energy_dec) write(iout,*)
6291 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
6293 C Checking if it involves dummy (NH3+ or COO-) group
6294 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
6295 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
6296 diff = vbld(i)-vbldpDUM
6297 if (energy_dec) write(iout,*) "dum_bond",i,diff
6299 C NO vbldp0 is the equlibrium lenght of spring for peptide group
6300 diff = vbld(i)-vbldp0
6302 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
6303 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
6306 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
6308 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
6312 estr=0.5d0*AKP*estr+estr1
6314 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
6316 do i=ibond_start,ibond_end
6318 if (iti.ne.10 .and. iti.ne.ntyp1) then
6321 diff=vbld(i+nres)-vbldsc0(1,iti)
6322 if (energy_dec) write (iout,*)
6323 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
6324 & AKSC(1,iti),AKSC(1,iti)*diff*diff
6325 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
6327 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
6331 diff=vbld(i+nres)-vbldsc0(j,iti)
6332 if (energy_dec) write (iout,*)
6333 & "estr sc",i,iti,vbld(i+nres),vbldsc0(j,iti),diff,
6334 & AKSC(j,iti),AKSC(j,iti)*diff*diff
6335 ud(j)=aksc(j,iti)*diff
6336 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
6350 uprod2=uprod2*u(k)*u(k)
6354 usumsqder=usumsqder+ud(j)*uprod2
6356 estr=estr+uprod/usum
6358 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
6366 C--------------------------------------------------------------------------
6367 subroutine ebend(etheta,ethetacnstr)
6369 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6370 C angles gamma and its derivatives in consecutive thetas and gammas.
6372 implicit real*8 (a-h,o-z)
6373 include 'DIMENSIONS'
6374 include 'COMMON.LOCAL'
6375 include 'COMMON.GEO'
6376 include 'COMMON.INTERACT'
6377 include 'COMMON.DERIV'
6378 include 'COMMON.VAR'
6379 include 'COMMON.CHAIN'
6380 include 'COMMON.IOUNITS'
6381 include 'COMMON.NAMES'
6382 include 'COMMON.FFIELD'
6383 include 'COMMON.CONTROL'
6384 include 'COMMON.TORCNSTR'
6385 common /calcthet/ term1,term2,termm,diffak,ratak,
6386 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6387 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6388 double precision y(2),z(2)
6390 c time11=dexp(-2*time)
6393 c write (*,'(a,i2)') 'EBEND ICG=',icg
6394 do i=ithet_start,ithet_end
6395 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6396 & .or.itype(i).eq.ntyp1) cycle
6397 C Zero the energy function and its derivative at 0 or pi.
6398 call splinthet(theta(i),0.5d0*delta,ss,ssd)
6400 ichir1=isign(1,itype(i-2))
6401 ichir2=isign(1,itype(i))
6402 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
6403 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
6404 if (itype(i-1).eq.10) then
6405 itype1=isign(10,itype(i-2))
6406 ichir11=isign(1,itype(i-2))
6407 ichir12=isign(1,itype(i-2))
6408 itype2=isign(10,itype(i))
6409 ichir21=isign(1,itype(i))
6410 ichir22=isign(1,itype(i))
6413 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
6416 if (phii.ne.phii) phii=150.0
6426 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6429 if (phii1.ne.phii1) phii1=150.0
6441 C Calculate the "mean" value of theta from the part of the distribution
6442 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
6443 C In following comments this theta will be referred to as t_c.
6444 thet_pred_mean=0.0d0
6446 athetk=athet(k,it,ichir1,ichir2)
6447 bthetk=bthet(k,it,ichir1,ichir2)
6449 athetk=athet(k,itype1,ichir11,ichir12)
6450 bthetk=bthet(k,itype2,ichir21,ichir22)
6452 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
6453 c write(iout,*) 'chuj tu', y(k),z(k)
6455 dthett=thet_pred_mean*ssd
6456 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
6457 C Derivatives of the "mean" values in gamma1 and gamma2.
6458 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
6459 &+athet(2,it,ichir1,ichir2)*y(1))*ss
6460 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
6461 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
6463 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
6464 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
6465 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
6466 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
6468 if (theta(i).gt.pi-delta) then
6469 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
6471 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
6472 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6473 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
6475 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
6477 else if (theta(i).lt.delta) then
6478 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
6479 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6480 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
6482 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
6483 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
6486 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
6489 etheta=etheta+ethetai
6490 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
6491 & 'ebend',i,ethetai,theta(i),itype(i)
6492 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
6493 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
6494 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
6497 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6498 do i=ithetaconstr_start,ithetaconstr_end
6499 itheta=itheta_constr(i)
6500 thetiii=theta(itheta)
6501 difi=pinorm(thetiii-theta_constr0(i))
6502 if (difi.gt.theta_drange(i)) then
6503 difi=difi-theta_drange(i)
6504 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6505 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6506 & +for_thet_constr(i)*difi**3
6507 else if (difi.lt.-drange(i)) then
6509 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
6510 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6511 & +for_thet_constr(i)*difi**3
6515 if (energy_dec) then
6516 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6517 & i,itheta,rad2deg*thetiii,
6518 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6519 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6520 & gloc(itheta+nphi-2,icg)
6524 C Ufff.... We've done all this!!!
6527 C---------------------------------------------------------------------------
6528 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
6530 implicit real*8 (a-h,o-z)
6531 include 'DIMENSIONS'
6532 include 'COMMON.LOCAL'
6533 include 'COMMON.IOUNITS'
6534 common /calcthet/ term1,term2,termm,diffak,ratak,
6535 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6536 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6537 C Calculate the contributions to both Gaussian lobes.
6538 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6539 C The "polynomial part" of the "standard deviation" of this part of
6540 C the distributioni.
6541 ccc write (iout,*) thetai,thet_pred_mean
6544 sig=sig*thet_pred_mean+polthet(j,it)
6546 C Derivative of the "interior part" of the "standard deviation of the"
6547 C gamma-dependent Gaussian lobe in t_c.
6548 sigtc=3*polthet(3,it)
6550 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6553 C Set the parameters of both Gaussian lobes of the distribution.
6554 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6555 fac=sig*sig+sigc0(it)
6558 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6559 sigsqtc=-4.0D0*sigcsq*sigtc
6560 c print *,i,sig,sigtc,sigsqtc
6561 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
6562 sigtc=-sigtc/(fac*fac)
6563 C Following variable is sigma(t_c)**(-2)
6564 sigcsq=sigcsq*sigcsq
6566 sig0inv=1.0D0/sig0i**2
6567 delthec=thetai-thet_pred_mean
6568 delthe0=thetai-theta0i
6569 term1=-0.5D0*sigcsq*delthec*delthec
6570 term2=-0.5D0*sig0inv*delthe0*delthe0
6571 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
6572 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6573 C NaNs in taking the logarithm. We extract the largest exponent which is added
6574 C to the energy (this being the log of the distribution) at the end of energy
6575 C term evaluation for this virtual-bond angle.
6576 if (term1.gt.term2) then
6578 term2=dexp(term2-termm)
6582 term1=dexp(term1-termm)
6585 C The ratio between the gamma-independent and gamma-dependent lobes of
6586 C the distribution is a Gaussian function of thet_pred_mean too.
6587 diffak=gthet(2,it)-thet_pred_mean
6588 ratak=diffak/gthet(3,it)**2
6589 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6590 C Let's differentiate it in thet_pred_mean NOW.
6592 C Now put together the distribution terms to make complete distribution.
6593 termexp=term1+ak*term2
6594 termpre=sigc+ak*sig0i
6595 C Contribution of the bending energy from this theta is just the -log of
6596 C the sum of the contributions from the two lobes and the pre-exponential
6597 C factor. Simple enough, isn't it?
6598 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6599 C write (iout,*) 'termexp',termexp,termm,termpre,i
6600 C NOW the derivatives!!!
6601 C 6/6/97 Take into account the deformation.
6602 E_theta=(delthec*sigcsq*term1
6603 & +ak*delthe0*sig0inv*term2)/termexp
6604 E_tc=((sigtc+aktc*sig0i)/termpre
6605 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
6606 & aktc*term2)/termexp)
6609 c-----------------------------------------------------------------------------
6610 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
6611 implicit real*8 (a-h,o-z)
6612 include 'DIMENSIONS'
6613 include 'COMMON.LOCAL'
6614 include 'COMMON.IOUNITS'
6615 common /calcthet/ term1,term2,termm,diffak,ratak,
6616 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6617 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6618 delthec=thetai-thet_pred_mean
6619 delthe0=thetai-theta0i
6620 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
6621 t3 = thetai-thet_pred_mean
6625 t14 = t12+t6*sigsqtc
6627 t21 = thetai-theta0i
6633 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
6634 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
6635 & *(-t12*t9-ak*sig0inv*t27)
6639 C--------------------------------------------------------------------------
6640 subroutine ebend(etheta,ethetacnstr)
6642 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6643 C angles gamma and its derivatives in consecutive thetas and gammas.
6644 C ab initio-derived potentials from
6645 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6647 implicit real*8 (a-h,o-z)
6648 include 'DIMENSIONS'
6649 include 'COMMON.LOCAL'
6650 include 'COMMON.GEO'
6651 include 'COMMON.INTERACT'
6652 include 'COMMON.DERIV'
6653 include 'COMMON.VAR'
6654 include 'COMMON.CHAIN'
6655 include 'COMMON.IOUNITS'
6656 include 'COMMON.NAMES'
6657 include 'COMMON.FFIELD'
6658 include 'COMMON.CONTROL'
6659 include 'COMMON.TORCNSTR'
6660 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
6661 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
6662 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
6663 & sinph1ph2(maxdouble,maxdouble)
6664 logical lprn /.false./, lprn1 /.false./
6666 do i=ithet_start,ithet_end
6667 c print *,i,itype(i-1),itype(i),itype(i-2)
6668 C if (itype(i-1).eq.ntyp1) cycle
6669 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6670 & .or.itype(i).eq.ntyp1) cycle
6671 C print *,i,theta(i)
6672 if (iabs(itype(i+1)).eq.20) iblock=2
6673 if (iabs(itype(i+1)).ne.20) iblock=1
6677 theti2=0.5d0*theta(i)
6678 ityp2=ithetyp((itype(i-1)))
6680 coskt(k)=dcos(k*theti2)
6681 sinkt(k)=dsin(k*theti2)
6684 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
6687 if (phii.ne.phii) phii=150.0
6691 ityp1=ithetyp((itype(i-2)))
6692 C propagation of chirality for glycine type
6694 cosph1(k)=dcos(k*phii)
6695 sinph1(k)=dsin(k*phii)
6700 ityp1=ithetyp((itype(i-2)))
6705 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6708 if (phii1.ne.phii1) phii1=150.0
6713 ityp3=ithetyp((itype(i)))
6715 cosph2(k)=dcos(k*phii1)
6716 sinph2(k)=dsin(k*phii1)
6720 ityp3=ithetyp((itype(i)))
6726 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
6729 ccl=cosph1(l)*cosph2(k-l)
6730 ssl=sinph1(l)*sinph2(k-l)
6731 scl=sinph1(l)*cosph2(k-l)
6732 csl=cosph1(l)*sinph2(k-l)
6733 cosph1ph2(l,k)=ccl-ssl
6734 cosph1ph2(k,l)=ccl+ssl
6735 sinph1ph2(l,k)=scl+csl
6736 sinph1ph2(k,l)=scl-csl
6740 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
6741 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6742 write (iout,*) "coskt and sinkt"
6744 write (iout,*) k,coskt(k),sinkt(k)
6748 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6749 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
6752 & write (iout,*) "k",k,"
6753 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
6754 & " ethetai",ethetai
6757 write (iout,*) "cosph and sinph"
6759 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6761 write (iout,*) "cosph1ph2 and sinph2ph2"
6764 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6765 & sinph1ph2(l,k),sinph1ph2(k,l)
6768 write(iout,*) "ethetai",ethetai
6773 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
6774 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
6775 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
6776 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6777 ethetai=ethetai+sinkt(m)*aux
6778 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6779 dephii=dephii+k*sinkt(m)*(
6780 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
6781 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6782 dephii1=dephii1+k*sinkt(m)*(
6783 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
6784 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6786 & write (iout,*) "m",m," k",k," bbthet",
6787 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
6788 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
6789 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
6790 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6791 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6794 C print *,"cosph1", (cosph1(k), k=1,nsingle)
6795 C print *,"cosph2", (cosph2(k), k=1,nsingle)
6796 C print *,"sinph1", (sinph1(k), k=1,nsingle)
6797 C print *,"sinph2", (sinph2(k), k=1,nsingle)
6799 & write(iout,*) "ethetai",ethetai
6800 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6804 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6805 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
6806 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6807 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6808 ethetai=ethetai+sinkt(m)*aux
6809 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6810 dephii=dephii+l*sinkt(m)*(
6811 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
6812 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6813 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6814 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6815 dephii1=dephii1+(k-l)*sinkt(m)*(
6816 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6817 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6818 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
6819 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6821 write (iout,*) "m",m," k",k," l",l," ffthet",
6822 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6823 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
6824 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6825 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
6826 & " ethetai",ethetai
6827 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6828 & cosph1ph2(k,l)*sinkt(m),
6829 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6838 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6839 & i,theta(i)*rad2deg,phii*rad2deg,
6840 & phii1*rad2deg,ethetai
6842 etheta=etheta+ethetai
6843 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6844 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6845 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
6849 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6850 do i=ithetaconstr_start,ithetaconstr_end
6851 itheta=itheta_constr(i)
6852 thetiii=theta(itheta)
6853 difi=pinorm(thetiii-theta_constr0(i))
6854 if (difi.gt.theta_drange(i)) then
6855 difi=difi-theta_drange(i)
6856 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6857 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6858 & +for_thet_constr(i)*difi**3
6859 else if (difi.lt.-drange(i)) then
6861 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6862 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6863 & +for_thet_constr(i)*difi**3
6867 if (energy_dec) then
6868 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6869 & i,itheta,rad2deg*thetiii,
6870 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6871 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6872 & gloc(itheta+nphi-2,icg)
6880 c-----------------------------------------------------------------------------
6881 subroutine esc(escloc)
6882 C Calculate the local energy of a side chain and its derivatives in the
6883 C corresponding virtual-bond valence angles THETA and the spherical angles
6885 implicit real*8 (a-h,o-z)
6886 include 'DIMENSIONS'
6887 include 'COMMON.GEO'
6888 include 'COMMON.LOCAL'
6889 include 'COMMON.VAR'
6890 include 'COMMON.INTERACT'
6891 include 'COMMON.DERIV'
6892 include 'COMMON.CHAIN'
6893 include 'COMMON.IOUNITS'
6894 include 'COMMON.NAMES'
6895 include 'COMMON.FFIELD'
6896 include 'COMMON.CONTROL'
6897 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6898 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6899 common /sccalc/ time11,time12,time112,theti,it,nlobit
6902 c write (iout,'(a)') 'ESC'
6903 do i=loc_start,loc_end
6905 if (it.eq.ntyp1) cycle
6906 if (it.eq.10) goto 1
6907 nlobit=nlob(iabs(it))
6908 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6909 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6910 theti=theta(i+1)-pipol
6915 if (x(2).gt.pi-delta) then
6919 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6921 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6922 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6924 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6925 & ddersc0(1),dersc(1))
6926 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6927 & ddersc0(3),dersc(3))
6929 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6931 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6932 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6933 & dersc0(2),esclocbi,dersc02)
6934 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6936 call splinthet(x(2),0.5d0*delta,ss,ssd)
6941 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6943 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6944 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6946 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6948 c write (iout,*) escloci
6949 else if (x(2).lt.delta) then
6953 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6955 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6956 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6958 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6959 & ddersc0(1),dersc(1))
6960 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6961 & ddersc0(3),dersc(3))
6963 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6965 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6966 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6967 & dersc0(2),esclocbi,dersc02)
6968 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6973 call splinthet(x(2),0.5d0*delta,ss,ssd)
6975 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6977 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6978 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6980 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6981 c write (iout,*) escloci
6983 call enesc(x,escloci,dersc,ddummy,.false.)
6986 escloc=escloc+escloci
6987 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6988 & 'escloc',i,escloci
6989 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6991 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6993 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6994 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6999 C---------------------------------------------------------------------------
7000 subroutine enesc(x,escloci,dersc,ddersc,mixed)
7001 implicit real*8 (a-h,o-z)
7002 include 'DIMENSIONS'
7003 include 'COMMON.GEO'
7004 include 'COMMON.LOCAL'
7005 include 'COMMON.IOUNITS'
7006 common /sccalc/ time11,time12,time112,theti,it,nlobit
7007 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
7008 double precision contr(maxlob,-1:1)
7010 c write (iout,*) 'it=',it,' nlobit=',nlobit
7014 if (mixed) ddersc(j)=0.0d0
7018 C Because of periodicity of the dependence of the SC energy in omega we have
7019 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
7020 C To avoid underflows, first compute & store the exponents.
7028 z(k)=x(k)-censc(k,j,it)
7033 Axk=Axk+gaussc(l,k,j,it)*z(l)
7039 expfac=expfac+Ax(k,j,iii)*z(k)
7047 C As in the case of ebend, we want to avoid underflows in exponentiation and
7048 C subsequent NaNs and INFs in energy calculation.
7049 C Find the largest exponent
7053 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
7057 cd print *,'it=',it,' emin=',emin
7059 C Compute the contribution to SC energy and derivatives
7064 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
7065 if(adexp.ne.adexp) adexp=1.0
7068 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
7070 cd print *,'j=',j,' expfac=',expfac
7071 escloc_i=escloc_i+expfac
7073 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
7077 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
7078 & +gaussc(k,2,j,it))*expfac
7085 dersc(1)=dersc(1)/cos(theti)**2
7086 ddersc(1)=ddersc(1)/cos(theti)**2
7089 escloci=-(dlog(escloc_i)-emin)
7091 dersc(j)=dersc(j)/escloc_i
7095 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
7100 C------------------------------------------------------------------------------
7101 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
7102 implicit real*8 (a-h,o-z)
7103 include 'DIMENSIONS'
7104 include 'COMMON.GEO'
7105 include 'COMMON.LOCAL'
7106 include 'COMMON.IOUNITS'
7107 common /sccalc/ time11,time12,time112,theti,it,nlobit
7108 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
7109 double precision contr(maxlob)
7120 z(k)=x(k)-censc(k,j,it)
7126 Axk=Axk+gaussc(l,k,j,it)*z(l)
7132 expfac=expfac+Ax(k,j)*z(k)
7137 C As in the case of ebend, we want to avoid underflows in exponentiation and
7138 C subsequent NaNs and INFs in energy calculation.
7139 C Find the largest exponent
7142 if (emin.gt.contr(j)) emin=contr(j)
7146 C Compute the contribution to SC energy and derivatives
7150 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
7151 escloc_i=escloc_i+expfac
7153 dersc(k)=dersc(k)+Ax(k,j)*expfac
7155 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
7156 & +gaussc(1,2,j,it))*expfac
7160 dersc(1)=dersc(1)/cos(theti)**2
7161 dersc12=dersc12/cos(theti)**2
7162 escloci=-(dlog(escloc_i)-emin)
7164 dersc(j)=dersc(j)/escloc_i
7166 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
7170 c----------------------------------------------------------------------------------
7171 subroutine esc(escloc)
7172 C Calculate the local energy of a side chain and its derivatives in the
7173 C corresponding virtual-bond valence angles THETA and the spherical angles
7174 C ALPHA and OMEGA derived from AM1 all-atom calculations.
7175 C added by Urszula Kozlowska. 07/11/2007
7177 implicit real*8 (a-h,o-z)
7178 include 'DIMENSIONS'
7179 include 'COMMON.GEO'
7180 include 'COMMON.LOCAL'
7181 include 'COMMON.VAR'
7182 include 'COMMON.SCROT'
7183 include 'COMMON.INTERACT'
7184 include 'COMMON.DERIV'
7185 include 'COMMON.CHAIN'
7186 include 'COMMON.IOUNITS'
7187 include 'COMMON.NAMES'
7188 include 'COMMON.FFIELD'
7189 include 'COMMON.CONTROL'
7190 include 'COMMON.VECTORS'
7191 double precision x_prime(3),y_prime(3),z_prime(3)
7192 & , sumene,dsc_i,dp2_i,x(65),
7193 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
7194 & de_dxx,de_dyy,de_dzz,de_dt
7195 double precision s1_t,s1_6_t,s2_t,s2_6_t
7197 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
7198 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
7199 & dt_dCi(3),dt_dCi1(3)
7200 common /sccalc/ time11,time12,time112,theti,it,nlobit
7203 do i=loc_start,loc_end
7204 if (itype(i).eq.ntyp1) cycle
7205 costtab(i+1) =dcos(theta(i+1))
7206 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
7207 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
7208 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
7209 cosfac2=0.5d0/(1.0d0+costtab(i+1))
7210 cosfac=dsqrt(cosfac2)
7211 sinfac2=0.5d0/(1.0d0-costtab(i+1))
7212 sinfac=dsqrt(sinfac2)
7214 if (it.eq.10) goto 1
7216 C Compute the axes of tghe local cartesian coordinates system; store in
7217 c x_prime, y_prime and z_prime
7224 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
7225 C & dc_norm(3,i+nres)
7227 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
7228 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
7231 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
7234 c write (2,*) "x_prime",(x_prime(j),j=1,3)
7235 c write (2,*) "y_prime",(y_prime(j),j=1,3)
7236 c write (2,*) "z_prime",(z_prime(j),j=1,3)
7237 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
7238 c & " xy",scalar(x_prime(1),y_prime(1)),
7239 c & " xz",scalar(x_prime(1),z_prime(1)),
7240 c & " yy",scalar(y_prime(1),y_prime(1)),
7241 c & " yz",scalar(y_prime(1),z_prime(1)),
7242 c & " zz",scalar(z_prime(1),z_prime(1))
7244 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
7245 C to local coordinate system. Store in xx, yy, zz.
7251 xx = xx + x_prime(j)*dc_norm(j,i+nres)
7252 yy = yy + y_prime(j)*dc_norm(j,i+nres)
7253 zz = zz + z_prime(j)*dc_norm(j,i+nres)
7260 C Compute the energy of the ith side cbain
7262 c write (2,*) "xx",xx," yy",yy," zz",zz
7265 x(j) = sc_parmin(j,it)
7268 Cc diagnostics - remove later
7270 yy1 = dsin(alph(2))*dcos(omeg(2))
7271 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
7272 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
7273 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
7275 C," --- ", xx_w,yy_w,zz_w
7278 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7279 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7281 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7282 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7284 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7285 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7286 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7287 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7288 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7290 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7291 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7292 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7293 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7294 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7296 dsc_i = 0.743d0+x(61)
7298 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7299 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
7300 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7301 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
7302 s1=(1+x(63))/(0.1d0 + dscp1)
7303 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7304 s2=(1+x(65))/(0.1d0 + dscp2)
7305 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7306 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
7307 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
7308 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
7310 c & dscp1,dscp2,sumene
7311 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7312 escloc = escloc + sumene
7313 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
7318 C This section to check the numerical derivatives of the energy of ith side
7319 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
7320 C #define DEBUG in the code to turn it on.
7322 write (2,*) "sumene =",sumene
7326 write (2,*) xx,yy,zz
7327 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7328 de_dxx_num=(sumenep-sumene)/aincr
7330 write (2,*) "xx+ sumene from enesc=",sumenep
7333 write (2,*) xx,yy,zz
7334 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7335 de_dyy_num=(sumenep-sumene)/aincr
7337 write (2,*) "yy+ sumene from enesc=",sumenep
7340 write (2,*) xx,yy,zz
7341 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7342 de_dzz_num=(sumenep-sumene)/aincr
7344 write (2,*) "zz+ sumene from enesc=",sumenep
7345 costsave=cost2tab(i+1)
7346 sintsave=sint2tab(i+1)
7347 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
7348 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
7349 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7350 de_dt_num=(sumenep-sumene)/aincr
7351 write (2,*) " t+ sumene from enesc=",sumenep
7352 cost2tab(i+1)=costsave
7353 sint2tab(i+1)=sintsave
7354 C End of diagnostics section.
7357 C Compute the gradient of esc
7359 c zz=zz*dsign(1.0,dfloat(itype(i)))
7360 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
7361 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
7362 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
7363 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
7364 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
7365 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
7366 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
7367 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
7368 pom1=(sumene3*sint2tab(i+1)+sumene1)
7369 & *(pom_s1/dscp1+pom_s16*dscp1**4)
7370 pom2=(sumene4*cost2tab(i+1)+sumene2)
7371 & *(pom_s2/dscp2+pom_s26*dscp2**4)
7372 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
7373 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
7374 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
7376 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
7377 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
7378 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
7380 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
7381 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
7382 & +(pom1+pom2)*pom_dx
7384 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
7387 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
7388 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
7389 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
7391 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
7392 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
7393 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
7394 & +x(59)*zz**2 +x(60)*xx*zz
7395 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
7396 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
7397 & +(pom1-pom2)*pom_dy
7399 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
7402 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
7403 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
7404 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
7405 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
7406 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
7407 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
7408 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
7409 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
7411 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
7414 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
7415 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
7416 & +pom1*pom_dt1+pom2*pom_dt2
7418 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
7423 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
7424 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
7425 cosfac2xx=cosfac2*xx
7426 sinfac2yy=sinfac2*yy
7428 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
7430 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
7432 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
7433 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
7434 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
7435 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
7436 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
7437 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
7438 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
7439 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
7440 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
7441 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
7445 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
7446 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
7447 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
7448 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
7451 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
7452 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
7453 dZZ_XYZ(k)=vbld_inv(i+nres)*
7454 & (z_prime(k)-zz*dC_norm(k,i+nres))
7456 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
7457 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
7461 dXX_Ctab(k,i)=dXX_Ci(k)
7462 dXX_C1tab(k,i)=dXX_Ci1(k)
7463 dYY_Ctab(k,i)=dYY_Ci(k)
7464 dYY_C1tab(k,i)=dYY_Ci1(k)
7465 dZZ_Ctab(k,i)=dZZ_Ci(k)
7466 dZZ_C1tab(k,i)=dZZ_Ci1(k)
7467 dXX_XYZtab(k,i)=dXX_XYZ(k)
7468 dYY_XYZtab(k,i)=dYY_XYZ(k)
7469 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
7473 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
7474 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
7475 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
7476 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
7477 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
7479 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
7480 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
7481 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
7482 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
7483 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
7484 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
7485 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
7486 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
7488 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
7489 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
7491 C to check gradient call subroutine check_grad
7497 c------------------------------------------------------------------------------
7498 double precision function enesc(x,xx,yy,zz,cost2,sint2)
7500 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
7501 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
7502 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7503 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7505 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7506 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7508 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7509 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7510 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7511 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7512 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7514 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7515 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7516 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7517 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7518 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7520 dsc_i = 0.743d0+x(61)
7522 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7523 & *(xx*cost2+yy*sint2))
7524 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7525 & *(xx*cost2-yy*sint2))
7526 s1=(1+x(63))/(0.1d0 + dscp1)
7527 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7528 s2=(1+x(65))/(0.1d0 + dscp2)
7529 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7530 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
7531 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
7536 c------------------------------------------------------------------------------
7537 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
7539 C This procedure calculates two-body contact function g(rij) and its derivative:
7542 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
7545 C where x=(rij-r0ij)/delta
7547 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
7550 double precision rij,r0ij,eps0ij,fcont,fprimcont
7551 double precision x,x2,x4,delta
7555 if (x.lt.-1.0D0) then
7558 else if (x.le.1.0D0) then
7561 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
7562 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7569 c------------------------------------------------------------------------------
7570 subroutine splinthet(theti,delta,ss,ssder)
7571 implicit real*8 (a-h,o-z)
7572 include 'DIMENSIONS'
7573 include 'COMMON.VAR'
7574 include 'COMMON.GEO'
7577 if (theti.gt.pipol) then
7578 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7580 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7585 c------------------------------------------------------------------------------
7586 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7588 double precision x,x0,delta,f0,f1,fprim0,f,fprim
7589 double precision ksi,ksi2,ksi3,a1,a2,a3
7590 a1=fprim0*delta/(f1-f0)
7596 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7597 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7600 c------------------------------------------------------------------------------
7601 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7603 double precision x,x0,delta,f0x,f1x,fprim0x,fx
7604 double precision ksi,ksi2,ksi3,a1,a2,a3
7609 a2=3*(f1x-f0x)-2*fprim0x*delta
7610 a3=fprim0x*delta-2*(f1x-f0x)
7611 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7614 C-----------------------------------------------------------------------------
7616 C-----------------------------------------------------------------------------
7617 subroutine etor(etors,edihcnstr)
7618 implicit real*8 (a-h,o-z)
7619 include 'DIMENSIONS'
7620 include 'COMMON.VAR'
7621 include 'COMMON.GEO'
7622 include 'COMMON.LOCAL'
7623 include 'COMMON.TORSION'
7624 include 'COMMON.INTERACT'
7625 include 'COMMON.DERIV'
7626 include 'COMMON.CHAIN'
7627 include 'COMMON.NAMES'
7628 include 'COMMON.IOUNITS'
7629 include 'COMMON.FFIELD'
7630 include 'COMMON.TORCNSTR'
7631 include 'COMMON.CONTROL'
7633 C Set lprn=.true. for debugging
7637 do i=iphi_start,iphi_end
7639 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7640 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7641 itori=itortyp(itype(i-2))
7642 itori1=itortyp(itype(i-1))
7645 C Proline-Proline pair is a special case...
7646 if (itori.eq.3 .and. itori1.eq.3) then
7647 if (phii.gt.-dwapi3) then
7649 fac=1.0D0/(1.0D0-cosphi)
7650 etorsi=v1(1,3,3)*fac
7651 etorsi=etorsi+etorsi
7652 etors=etors+etorsi-v1(1,3,3)
7653 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
7654 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7657 v1ij=v1(j+1,itori,itori1)
7658 v2ij=v2(j+1,itori,itori1)
7661 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7662 if (energy_dec) etors_ii=etors_ii+
7663 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7664 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7668 v1ij=v1(j,itori,itori1)
7669 v2ij=v2(j,itori,itori1)
7672 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7673 if (energy_dec) etors_ii=etors_ii+
7674 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7675 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7678 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7681 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7682 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7683 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7684 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7685 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7687 ! 6/20/98 - dihedral angle constraints
7690 itori=idih_constr(i)
7693 if (difi.gt.drange(i)) then
7695 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7696 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7697 else if (difi.lt.-drange(i)) then
7699 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
7700 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7702 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
7703 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7705 ! write (iout,*) 'edihcnstr',edihcnstr
7708 c------------------------------------------------------------------------------
7709 subroutine etor_d(etors_d)
7713 c----------------------------------------------------------------------------
7715 subroutine etor(etors,edihcnstr)
7716 implicit real*8 (a-h,o-z)
7717 include 'DIMENSIONS'
7718 include 'COMMON.VAR'
7719 include 'COMMON.GEO'
7720 include 'COMMON.LOCAL'
7721 include 'COMMON.TORSION'
7722 include 'COMMON.INTERACT'
7723 include 'COMMON.DERIV'
7724 include 'COMMON.CHAIN'
7725 include 'COMMON.NAMES'
7726 include 'COMMON.IOUNITS'
7727 include 'COMMON.FFIELD'
7728 include 'COMMON.TORCNSTR'
7729 include 'COMMON.CONTROL'
7731 C Set lprn=.true. for debugging
7735 do i=iphi_start,iphi_end
7736 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7737 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7738 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7739 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7740 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7741 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7742 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7743 C For introducing the NH3+ and COO- group please check the etor_d for reference
7746 if (iabs(itype(i)).eq.20) then
7751 itori=itortyp(itype(i-2))
7752 itori1=itortyp(itype(i-1))
7755 C Regular cosine and sine terms
7756 do j=1,nterm(itori,itori1,iblock)
7757 v1ij=v1(j,itori,itori1,iblock)
7758 v2ij=v2(j,itori,itori1,iblock)
7761 etors=etors+v1ij*cosphi+v2ij*sinphi
7762 if (energy_dec) etors_ii=etors_ii+
7763 & v1ij*cosphi+v2ij*sinphi
7764 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7768 C E = SUM ----------------------------------- - v1
7769 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7771 cosphi=dcos(0.5d0*phii)
7772 sinphi=dsin(0.5d0*phii)
7773 do j=1,nlor(itori,itori1,iblock)
7774 vl1ij=vlor1(j,itori,itori1)
7775 vl2ij=vlor2(j,itori,itori1)
7776 vl3ij=vlor3(j,itori,itori1)
7777 pom=vl2ij*cosphi+vl3ij*sinphi
7778 pom1=1.0d0/(pom*pom+1.0d0)
7779 etors=etors+vl1ij*pom1
7780 if (energy_dec) etors_ii=etors_ii+
7783 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7785 C Subtract the constant term
7786 etors=etors-v0(itori,itori1,iblock)
7787 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7788 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
7790 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7791 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7792 & (v1(j,itori,itori1,iblock),j=1,6),
7793 & (v2(j,itori,itori1,iblock),j=1,6)
7794 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7795 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7797 ! 6/20/98 - dihedral angle constraints
7799 c do i=1,ndih_constr
7800 do i=idihconstr_start,idihconstr_end
7801 itori=idih_constr(i)
7803 difi=pinorm(phii-phi0(i))
7804 if (difi.gt.drange(i)) then
7806 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7807 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7808 else if (difi.lt.-drange(i)) then
7810 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7811 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7815 if (energy_dec) then
7816 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
7817 & i,itori,rad2deg*phii,
7818 & rad2deg*phi0(i), rad2deg*drange(i),
7819 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
7822 cd write (iout,*) 'edihcnstr',edihcnstr
7825 c----------------------------------------------------------------------------
7826 subroutine etor_d(etors_d)
7827 C 6/23/01 Compute double torsional energy
7828 implicit real*8 (a-h,o-z)
7829 include 'DIMENSIONS'
7830 include 'COMMON.VAR'
7831 include 'COMMON.GEO'
7832 include 'COMMON.LOCAL'
7833 include 'COMMON.TORSION'
7834 include 'COMMON.INTERACT'
7835 include 'COMMON.DERIV'
7836 include 'COMMON.CHAIN'
7837 include 'COMMON.NAMES'
7838 include 'COMMON.IOUNITS'
7839 include 'COMMON.FFIELD'
7840 include 'COMMON.TORCNSTR'
7842 C Set lprn=.true. for debugging
7846 c write(iout,*) "a tu??"
7847 do i=iphid_start,iphid_end
7848 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7849 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7850 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
7851 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
7852 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
7853 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7854 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7855 & (itype(i+1).eq.ntyp1)) cycle
7856 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
7857 itori=itortyp(itype(i-2))
7858 itori1=itortyp(itype(i-1))
7859 itori2=itortyp(itype(i))
7865 if (iabs(itype(i+1)).eq.20) iblock=2
7866 C Iblock=2 Proline type
7867 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
7868 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
7869 C if (itype(i+1).eq.ntyp1) iblock=3
7870 C The problem of NH3+ group can be resolved by adding new parameters please note if there
7871 C IS or IS NOT need for this
7872 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
7873 C is (itype(i-3).eq.ntyp1) ntblock=2
7874 C ntblock is N-terminal blocking group
7876 C Regular cosine and sine terms
7877 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7878 C Example of changes for NH3+ blocking group
7879 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
7880 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
7881 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7882 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7883 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7884 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7885 cosphi1=dcos(j*phii)
7886 sinphi1=dsin(j*phii)
7887 cosphi2=dcos(j*phii1)
7888 sinphi2=dsin(j*phii1)
7889 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7890 & v2cij*cosphi2+v2sij*sinphi2
7891 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7892 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7894 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7896 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7897 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7898 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7899 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7900 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7901 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7902 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7903 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7904 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7905 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7906 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7907 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7908 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7909 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7912 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7913 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7918 C----------------------------------------------------------------------------------
7919 C The rigorous attempt to derive energy function
7920 subroutine etor_kcc(etors,edihcnstr)
7921 implicit real*8 (a-h,o-z)
7922 include 'DIMENSIONS'
7923 include 'COMMON.VAR'
7924 include 'COMMON.GEO'
7925 include 'COMMON.LOCAL'
7926 include 'COMMON.TORSION'
7927 include 'COMMON.INTERACT'
7928 include 'COMMON.DERIV'
7929 include 'COMMON.CHAIN'
7930 include 'COMMON.NAMES'
7931 include 'COMMON.IOUNITS'
7932 include 'COMMON.FFIELD'
7933 include 'COMMON.TORCNSTR'
7934 include 'COMMON.CONTROL'
7936 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
7937 C Set lprn=.true. for debugging
7940 C print *,"wchodze kcc"
7941 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
7942 if (tor_mode.ne.2) then
7945 do i=iphi_start,iphi_end
7946 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7947 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7948 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7949 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7950 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7951 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7952 itori=itortyp_kcc(itype(i-2))
7953 itori1=itortyp_kcc(itype(i-1))
7958 sumnonchebyshev=0.0d0
7960 C to avoid multiple devision by 2
7961 c theti22=0.5d0*theta(i)
7962 C theta 12 is the theta_1 /2
7963 C theta 22 is theta_2 /2
7964 c theti12=0.5d0*theta(i-1)
7965 C and appropriate sinus function
7966 sinthet1=dsin(theta(i-1))
7967 sinthet2=dsin(theta(i))
7968 costhet1=dcos(theta(i-1))
7969 costhet2=dcos(theta(i))
7970 c Cosines of halves thetas
7971 costheti12=0.5d0*(1.0d0+costhet1)
7972 costheti22=0.5d0*(1.0d0+costhet2)
7973 C to speed up lets store its mutliplication
7974 sint1t2=sinthet2*sinthet1
7976 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
7977 C +d_n*sin(n*gamma)) *
7978 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
7979 C we have two sum 1) Non-Chebyshev which is with n and gamma
7981 do j=1,nterm_kcc(itori,itori1)
7983 nval=nterm_kcc_Tb(itori,itori1)
7984 v1ij=v1_kcc(j,itori,itori1)
7985 v2ij=v2_kcc(j,itori,itori1)
7986 c write (iout,*) "i",i," j",j," v1",v1ij," v2",v2ij
7987 C v1ij is c_n and d_n in euation above
7991 sint1t2n=sint1t2n*sint1t2
7992 sumth1tyb1=tschebyshev(1,nval,v11_chyb(1,j,itori,itori1),
7994 gradth1tyb1=-0.5d0*sinthet1*gradtschebyshev(0,nval-1,
7995 & v11_chyb(1,j,itori,itori1),costheti12)
7996 c write (iout,*) "v11",(v11_chyb(k,j,itori,itori1),k=1,nval),
7997 c & " sumth1tyb1",sumth1tyb1," gradth1tyb1",gradth1tyb1
7998 sumth2tyb1=tschebyshev(1,nval,v21_chyb(1,j,itori,itori1),
8000 gradth2tyb1=-0.5d0*sinthet2*gradtschebyshev(0,nval-1,
8001 & v21_chyb(1,j,itori,itori1),costheti22)
8002 c write (iout,*) "v21",(v21_chyb(k,j,itori,itori1),k=1,nval),
8003 c & " sumth2tyb1",sumth2tyb1," gradth2tyb1",gradth2tyb1
8004 sumth1tyb2=tschebyshev(1,nval,v12_chyb(1,j,itori,itori1),
8006 gradth1tyb2=-0.5d0*sinthet1*gradtschebyshev(0,nval-1,
8007 & v12_chyb(1,j,itori,itori1),costheti12)
8008 c write (iout,*) "v12",(v12_chyb(k,j,itori,itori1),k=1,nval),
8009 c & " sumth1tyb2",sumth1tyb2," gradth1tyb2",gradth1tyb2
8010 sumth2tyb2=tschebyshev(1,nval,v22_chyb(1,j,itori,itori1),
8012 gradth2tyb2=-0.5d0*sinthet2*gradtschebyshev(0,nval-1,
8013 & v22_chyb(1,j,itori,itori1),costheti22)
8014 c write (iout,*) "v22",(v22_chyb(k,j,itori,itori1),k=1,nval),
8015 c & " sumth2tyb2",sumth2tyb2," gradth2tyb2",gradth2tyb2
8016 C etors=etors+sint1t2n*(v1ij*cosphi+v2ij*sinphi)
8017 C if (energy_dec) etors_ii=etors_ii+
8018 C & v1ij*cosphi+v2ij*sinphi
8019 C glocig is the gradient local i site in gamma
8020 actval1=v1ij*cosphi*(1.0d0+sumth1tyb1+sumth2tyb1)
8021 actval2=v2ij*sinphi*(1.0d0+sumth1tyb2+sumth2tyb2)
8022 etori=etori+sint1t2n*(actval1+actval2)
8024 & j*sint1t2n*(v2ij*cosphi*(1.0d0+sumth1tyb2+sumth2tyb2)
8025 & -v1ij*sinphi*(1.0d0+sumth1tyb1+sumth2tyb1))
8026 C now gradient over theta_1
8028 & j*sint1t2n1*costhet1*sinthet2*(actval1+actval2)+
8029 & sint1t2n*(v1ij*cosphi*gradth1tyb1+v2ij*sinphi*gradth1tyb2)
8031 & j*sint1t2n1*sinthet1*costhet2*(actval1+actval2)+
8032 & sint1t2n*(v1ij*cosphi*gradth2tyb1+v2ij*sinphi*gradth2tyb2)
8034 C now the Czebyshev polinominal sum
8035 c do k=1,nterm_kcc_Tb(itori,itori1)
8036 c thybt1(k)=v1_chyb(k,j,itori,itori1)
8037 c thybt2(k)=v2_chyb(k,j,itori,itori1)
8041 C print *, sumth1thyb, gradthybt1, sumth2thyb, gradthybt2,
8043 C & (0,nterm_kcc_Tb(itori,itori1)-1,thybt2(1),
8044 C & dcos(theti22)**2),
8047 C now overal sumation
8048 C print *,"sumnon", sumnonchebyshev,sumth1thyb+sumth2thyb
8051 C derivative over gamma
8052 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
8053 C derivative over theta1
8054 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
8055 C now derivative over theta2
8056 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
8058 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
8059 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
8061 C gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
8062 ! 6/20/98 - dihedral angle constraints
8063 if (tor_mode.ne.2) then
8065 c do i=1,ndih_constr
8066 do i=idihconstr_start,idihconstr_end
8067 itori=idih_constr(i)
8069 difi=pinorm(phii-phi0(i))
8070 if (difi.gt.drange(i)) then
8072 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
8073 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
8074 else if (difi.lt.-drange(i)) then
8076 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
8077 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
8086 C The rigorous attempt to derive energy function
8087 subroutine ebend_kcc(etheta,ethetacnstr)
8089 implicit real*8 (a-h,o-z)
8090 include 'DIMENSIONS'
8091 include 'COMMON.VAR'
8092 include 'COMMON.GEO'
8093 include 'COMMON.LOCAL'
8094 include 'COMMON.TORSION'
8095 include 'COMMON.INTERACT'
8096 include 'COMMON.DERIV'
8097 include 'COMMON.CHAIN'
8098 include 'COMMON.NAMES'
8099 include 'COMMON.IOUNITS'
8100 include 'COMMON.FFIELD'
8101 include 'COMMON.TORCNSTR'
8102 include 'COMMON.CONTROL'
8104 double precision thybt1(maxtermkcc)
8105 C Set lprn=.true. for debugging
8108 C print *,"wchodze kcc"
8109 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
8110 if (tor_mode.ne.2) etheta=0.0D0
8111 do i=ithet_start,ithet_end
8112 c print *,i,itype(i-1),itype(i),itype(i-2)
8113 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
8114 & .or.itype(i).eq.ntyp1) cycle
8115 iti=itortyp_kcc(itype(i-1))
8116 sinthet=dsin(theta(i)/2.0d0)
8117 costhet=dcos(theta(i)/2.0d0)
8118 do j=1,nbend_kcc_Tb(iti)
8119 thybt1(j)=v1bend_chyb(j,iti)
8121 sumth1thyb=tschebyshev
8122 & (1,nbend_kcc_Tb(iti),thybt1(1),costhet)
8123 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
8125 ihelp=nbend_kcc_Tb(iti)-1
8126 gradthybt1=gradtschebyshev
8127 & (0,ihelp,thybt1(1),costhet)
8128 etheta=etheta+sumth1thyb
8129 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
8130 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*
8131 & gradthybt1*sinthet*(-0.5d0)
8133 if (tor_mode.ne.2) then
8135 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
8136 do i=ithetaconstr_start,ithetaconstr_end
8137 itheta=itheta_constr(i)
8138 thetiii=theta(itheta)
8139 difi=pinorm(thetiii-theta_constr0(i))
8140 if (difi.gt.theta_drange(i)) then
8141 difi=difi-theta_drange(i)
8142 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
8143 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
8144 & +for_thet_constr(i)*difi**3
8145 else if (difi.lt.-drange(i)) then
8147 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
8148 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
8149 & +for_thet_constr(i)*difi**3
8153 if (energy_dec) then
8154 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
8155 & i,itheta,rad2deg*thetiii,
8156 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
8157 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
8158 & gloc(itheta+nphi-2,icg)
8164 c------------------------------------------------------------------------------
8165 subroutine eback_sc_corr(esccor)
8166 c 7/21/2007 Correlations between the backbone-local and side-chain-local
8167 c conformational states; temporarily implemented as differences
8168 c between UNRES torsional potentials (dependent on three types of
8169 c residues) and the torsional potentials dependent on all 20 types
8170 c of residues computed from AM1 energy surfaces of terminally-blocked
8171 c amino-acid residues.
8172 implicit real*8 (a-h,o-z)
8173 include 'DIMENSIONS'
8174 include 'COMMON.VAR'
8175 include 'COMMON.GEO'
8176 include 'COMMON.LOCAL'
8177 include 'COMMON.TORSION'
8178 include 'COMMON.SCCOR'
8179 include 'COMMON.INTERACT'
8180 include 'COMMON.DERIV'
8181 include 'COMMON.CHAIN'
8182 include 'COMMON.NAMES'
8183 include 'COMMON.IOUNITS'
8184 include 'COMMON.FFIELD'
8185 include 'COMMON.CONTROL'
8187 C Set lprn=.true. for debugging
8190 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
8192 do i=itau_start,itau_end
8193 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
8195 isccori=isccortyp(itype(i-2))
8196 isccori1=isccortyp(itype(i-1))
8197 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
8199 do intertyp=1,3 !intertyp
8200 cc Added 09 May 2012 (Adasko)
8201 cc Intertyp means interaction type of backbone mainchain correlation:
8202 c 1 = SC...Ca...Ca...Ca
8203 c 2 = Ca...Ca...Ca...SC
8204 c 3 = SC...Ca...Ca...SCi
8206 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
8207 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
8208 & (itype(i-1).eq.ntyp1)))
8209 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
8210 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
8211 & .or.(itype(i).eq.ntyp1)))
8212 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
8213 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
8214 & (itype(i-3).eq.ntyp1)))) cycle
8215 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
8216 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
8218 do j=1,nterm_sccor(isccori,isccori1)
8219 v1ij=v1sccor(j,intertyp,isccori,isccori1)
8220 v2ij=v2sccor(j,intertyp,isccori,isccori1)
8221 cosphi=dcos(j*tauangle(intertyp,i))
8222 sinphi=dsin(j*tauangle(intertyp,i))
8223 esccor=esccor+v1ij*cosphi+v2ij*sinphi
8224 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
8226 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
8227 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
8229 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
8230 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
8231 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
8232 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
8233 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
8239 c----------------------------------------------------------------------------
8240 subroutine multibody(ecorr)
8241 C This subroutine calculates multi-body contributions to energy following
8242 C the idea of Skolnick et al. If side chains I and J make a contact and
8243 C at the same time side chains I+1 and J+1 make a contact, an extra
8244 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
8245 implicit real*8 (a-h,o-z)
8246 include 'DIMENSIONS'
8247 include 'COMMON.IOUNITS'
8248 include 'COMMON.DERIV'
8249 include 'COMMON.INTERACT'
8250 include 'COMMON.CONTACTS'
8251 double precision gx(3),gx1(3)
8254 C Set lprn=.true. for debugging
8258 write (iout,'(a)') 'Contact function values:'
8260 write (iout,'(i2,20(1x,i2,f10.5))')
8261 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
8276 num_conti=num_cont(i)
8277 num_conti1=num_cont(i1)
8282 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
8283 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8284 cd & ' ishift=',ishift
8285 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
8286 C The system gains extra energy.
8287 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
8288 endif ! j1==j+-ishift
8297 c------------------------------------------------------------------------------
8298 double precision function esccorr(i,j,k,l,jj,kk)
8299 implicit real*8 (a-h,o-z)
8300 include 'DIMENSIONS'
8301 include 'COMMON.IOUNITS'
8302 include 'COMMON.DERIV'
8303 include 'COMMON.INTERACT'
8304 include 'COMMON.CONTACTS'
8305 include 'COMMON.SHIELD'
8306 double precision gx(3),gx1(3)
8311 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
8312 C Calculate the multi-body contribution to energy.
8313 C Calculate multi-body contributions to the gradient.
8314 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
8315 cd & k,l,(gacont(m,kk,k),m=1,3)
8317 gx(m) =ekl*gacont(m,jj,i)
8318 gx1(m)=eij*gacont(m,kk,k)
8319 gradxorr(m,i)=gradxorr(m,i)-gx(m)
8320 gradxorr(m,j)=gradxorr(m,j)+gx(m)
8321 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
8322 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
8326 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
8331 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
8337 c------------------------------------------------------------------------------
8338 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
8339 C This subroutine calculates multi-body contributions to hydrogen-bonding
8340 implicit real*8 (a-h,o-z)
8341 include 'DIMENSIONS'
8342 include 'COMMON.IOUNITS'
8345 parameter (max_cont=maxconts)
8346 parameter (max_dim=26)
8347 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8348 double precision zapas(max_dim,maxconts,max_fg_procs),
8349 & zapas_recv(max_dim,maxconts,max_fg_procs)
8350 common /przechowalnia/ zapas
8351 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8352 & status_array(MPI_STATUS_SIZE,maxconts*2)
8354 include 'COMMON.SETUP'
8355 include 'COMMON.FFIELD'
8356 include 'COMMON.DERIV'
8357 include 'COMMON.INTERACT'
8358 include 'COMMON.CONTACTS'
8359 include 'COMMON.CONTROL'
8360 include 'COMMON.LOCAL'
8361 double precision gx(3),gx1(3),time00
8364 C Set lprn=.true. for debugging
8369 if (nfgtasks.le.1) goto 30
8371 write (iout,'(a)') 'Contact function values before RECEIVE:'
8373 write (iout,'(2i3,50(1x,i2,f5.2))')
8374 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8375 & j=1,num_cont_hb(i))
8379 do i=1,ntask_cont_from
8382 do i=1,ntask_cont_to
8385 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8387 C Make the list of contacts to send to send to other procesors
8388 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
8390 do i=iturn3_start,iturn3_end
8391 c write (iout,*) "make contact list turn3",i," num_cont",
8393 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
8395 do i=iturn4_start,iturn4_end
8396 c write (iout,*) "make contact list turn4",i," num_cont",
8398 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
8402 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8404 do j=1,num_cont_hb(i)
8407 iproc=iint_sent_local(k,jjc,ii)
8408 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8409 if (iproc.gt.0) then
8410 ncont_sent(iproc)=ncont_sent(iproc)+1
8411 nn=ncont_sent(iproc)
8413 zapas(2,nn,iproc)=jjc
8414 zapas(3,nn,iproc)=facont_hb(j,i)
8415 zapas(4,nn,iproc)=ees0p(j,i)
8416 zapas(5,nn,iproc)=ees0m(j,i)
8417 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
8418 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
8419 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
8420 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
8421 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
8422 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
8423 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
8424 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
8425 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
8426 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
8427 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
8428 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
8429 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
8430 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
8431 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
8432 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
8433 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
8434 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
8435 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
8436 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
8437 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
8444 & "Numbers of contacts to be sent to other processors",
8445 & (ncont_sent(i),i=1,ntask_cont_to)
8446 write (iout,*) "Contacts sent"
8447 do ii=1,ntask_cont_to
8449 iproc=itask_cont_to(ii)
8450 write (iout,*) nn," contacts to processor",iproc,
8451 & " of CONT_TO_COMM group"
8453 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8461 CorrelID1=nfgtasks+fg_rank+1
8463 C Receive the numbers of needed contacts from other processors
8464 do ii=1,ntask_cont_from
8465 iproc=itask_cont_from(ii)
8467 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8468 & FG_COMM,req(ireq),IERR)
8470 c write (iout,*) "IRECV ended"
8472 C Send the number of contacts needed by other processors
8473 do ii=1,ntask_cont_to
8474 iproc=itask_cont_to(ii)
8476 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8477 & FG_COMM,req(ireq),IERR)
8479 c write (iout,*) "ISEND ended"
8480 c write (iout,*) "number of requests (nn)",ireq
8483 & call MPI_Waitall(ireq,req,status_array,ierr)
8485 c & "Numbers of contacts to be received from other processors",
8486 c & (ncont_recv(i),i=1,ntask_cont_from)
8490 do ii=1,ntask_cont_from
8491 iproc=itask_cont_from(ii)
8493 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8494 c & " of CONT_TO_COMM group"
8498 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8499 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8500 c write (iout,*) "ireq,req",ireq,req(ireq)
8503 C Send the contacts to processors that need them
8504 do ii=1,ntask_cont_to
8505 iproc=itask_cont_to(ii)
8507 c write (iout,*) nn," contacts to processor",iproc,
8508 c & " of CONT_TO_COMM group"
8511 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8512 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8513 c write (iout,*) "ireq,req",ireq,req(ireq)
8515 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8519 c write (iout,*) "number of requests (contacts)",ireq
8520 c write (iout,*) "req",(req(i),i=1,4)
8523 & call MPI_Waitall(ireq,req,status_array,ierr)
8524 do iii=1,ntask_cont_from
8525 iproc=itask_cont_from(iii)
8528 write (iout,*) "Received",nn," contacts from processor",iproc,
8529 & " of CONT_FROM_COMM group"
8532 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8537 ii=zapas_recv(1,i,iii)
8538 c Flag the received contacts to prevent double-counting
8539 jj=-zapas_recv(2,i,iii)
8540 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8542 nnn=num_cont_hb(ii)+1
8545 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8546 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8547 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8548 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8549 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8550 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8551 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8552 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8553 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8554 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8555 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8556 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8557 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8558 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8559 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8560 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8561 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8562 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8563 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8564 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8565 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8566 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8567 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8568 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8573 write (iout,'(a)') 'Contact function values after receive:'
8575 write (iout,'(2i3,50(1x,i3,f5.2))')
8576 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8577 & j=1,num_cont_hb(i))
8584 write (iout,'(a)') 'Contact function values:'
8586 write (iout,'(2i3,50(1x,i3,f5.2))')
8587 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8588 & j=1,num_cont_hb(i))
8592 C Remove the loop below after debugging !!!
8599 C Calculate the local-electrostatic correlation terms
8600 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8602 num_conti=num_cont_hb(i)
8603 num_conti1=num_cont_hb(i+1)
8610 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8611 c & ' jj=',jj,' kk=',kk
8612 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8613 & .or. j.lt.0 .and. j1.gt.0) .and.
8614 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8615 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8616 C The system gains extra energy.
8617 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8618 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
8619 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
8621 else if (j1.eq.j) then
8622 C Contacts I-J and I-(J+1) occur simultaneously.
8623 C The system loses extra energy.
8624 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8629 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8630 c & ' jj=',jj,' kk=',kk
8632 C Contacts I-J and (I+1)-J occur simultaneously.
8633 C The system loses extra energy.
8634 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8641 c------------------------------------------------------------------------------
8642 subroutine add_hb_contact(ii,jj,itask)
8643 implicit real*8 (a-h,o-z)
8644 include "DIMENSIONS"
8645 include "COMMON.IOUNITS"
8648 parameter (max_cont=maxconts)
8649 parameter (max_dim=26)
8650 include "COMMON.CONTACTS"
8651 double precision zapas(max_dim,maxconts,max_fg_procs),
8652 & zapas_recv(max_dim,maxconts,max_fg_procs)
8653 common /przechowalnia/ zapas
8654 integer i,j,ii,jj,iproc,itask(4),nn
8655 c write (iout,*) "itask",itask
8658 if (iproc.gt.0) then
8659 do j=1,num_cont_hb(ii)
8661 c write (iout,*) "i",ii," j",jj," jjc",jjc
8663 ncont_sent(iproc)=ncont_sent(iproc)+1
8664 nn=ncont_sent(iproc)
8665 zapas(1,nn,iproc)=ii
8666 zapas(2,nn,iproc)=jjc
8667 zapas(3,nn,iproc)=facont_hb(j,ii)
8668 zapas(4,nn,iproc)=ees0p(j,ii)
8669 zapas(5,nn,iproc)=ees0m(j,ii)
8670 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8671 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8672 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8673 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8674 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8675 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8676 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8677 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8678 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8679 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8680 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8681 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8682 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8683 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8684 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8685 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8686 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8687 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8688 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8689 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8690 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8698 c------------------------------------------------------------------------------
8699 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8701 C This subroutine calculates multi-body contributions to hydrogen-bonding
8702 implicit real*8 (a-h,o-z)
8703 include 'DIMENSIONS'
8704 include 'COMMON.IOUNITS'
8707 parameter (max_cont=maxconts)
8708 parameter (max_dim=70)
8709 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8710 double precision zapas(max_dim,maxconts,max_fg_procs),
8711 & zapas_recv(max_dim,maxconts,max_fg_procs)
8712 common /przechowalnia/ zapas
8713 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8714 & status_array(MPI_STATUS_SIZE,maxconts*2)
8716 include 'COMMON.SETUP'
8717 include 'COMMON.FFIELD'
8718 include 'COMMON.DERIV'
8719 include 'COMMON.LOCAL'
8720 include 'COMMON.INTERACT'
8721 include 'COMMON.CONTACTS'
8722 include 'COMMON.CHAIN'
8723 include 'COMMON.CONTROL'
8724 include 'COMMON.SHIELD'
8725 double precision gx(3),gx1(3)
8726 integer num_cont_hb_old(maxres)
8728 double precision eello4,eello5,eelo6,eello_turn6
8729 external eello4,eello5,eello6,eello_turn6
8730 C Set lprn=.true. for debugging
8735 num_cont_hb_old(i)=num_cont_hb(i)
8739 if (nfgtasks.le.1) goto 30
8741 write (iout,'(a)') 'Contact function values before RECEIVE:'
8743 write (iout,'(2i3,50(1x,i2,f5.2))')
8744 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8745 & j=1,num_cont_hb(i))
8749 do i=1,ntask_cont_from
8752 do i=1,ntask_cont_to
8755 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8757 C Make the list of contacts to send to send to other procesors
8758 do i=iturn3_start,iturn3_end
8759 c write (iout,*) "make contact list turn3",i," num_cont",
8761 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8763 do i=iturn4_start,iturn4_end
8764 c write (iout,*) "make contact list turn4",i," num_cont",
8766 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8770 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8772 do j=1,num_cont_hb(i)
8775 iproc=iint_sent_local(k,jjc,ii)
8776 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8777 if (iproc.ne.0) then
8778 ncont_sent(iproc)=ncont_sent(iproc)+1
8779 nn=ncont_sent(iproc)
8781 zapas(2,nn,iproc)=jjc
8782 zapas(3,nn,iproc)=d_cont(j,i)
8786 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8791 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8799 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8810 & "Numbers of contacts to be sent to other processors",
8811 & (ncont_sent(i),i=1,ntask_cont_to)
8812 write (iout,*) "Contacts sent"
8813 do ii=1,ntask_cont_to
8815 iproc=itask_cont_to(ii)
8816 write (iout,*) nn," contacts to processor",iproc,
8817 & " of CONT_TO_COMM group"
8819 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8827 CorrelID1=nfgtasks+fg_rank+1
8829 C Receive the numbers of needed contacts from other processors
8830 do ii=1,ntask_cont_from
8831 iproc=itask_cont_from(ii)
8833 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8834 & FG_COMM,req(ireq),IERR)
8836 c write (iout,*) "IRECV ended"
8838 C Send the number of contacts needed by other processors
8839 do ii=1,ntask_cont_to
8840 iproc=itask_cont_to(ii)
8842 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8843 & FG_COMM,req(ireq),IERR)
8845 c write (iout,*) "ISEND ended"
8846 c write (iout,*) "number of requests (nn)",ireq
8849 & call MPI_Waitall(ireq,req,status_array,ierr)
8851 c & "Numbers of contacts to be received from other processors",
8852 c & (ncont_recv(i),i=1,ntask_cont_from)
8856 do ii=1,ntask_cont_from
8857 iproc=itask_cont_from(ii)
8859 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8860 c & " of CONT_TO_COMM group"
8864 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8865 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8866 c write (iout,*) "ireq,req",ireq,req(ireq)
8869 C Send the contacts to processors that need them
8870 do ii=1,ntask_cont_to
8871 iproc=itask_cont_to(ii)
8873 c write (iout,*) nn," contacts to processor",iproc,
8874 c & " of CONT_TO_COMM group"
8877 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8878 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8879 c write (iout,*) "ireq,req",ireq,req(ireq)
8881 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8885 c write (iout,*) "number of requests (contacts)",ireq
8886 c write (iout,*) "req",(req(i),i=1,4)
8889 & call MPI_Waitall(ireq,req,status_array,ierr)
8890 do iii=1,ntask_cont_from
8891 iproc=itask_cont_from(iii)
8894 write (iout,*) "Received",nn," contacts from processor",iproc,
8895 & " of CONT_FROM_COMM group"
8898 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8903 ii=zapas_recv(1,i,iii)
8904 c Flag the received contacts to prevent double-counting
8905 jj=-zapas_recv(2,i,iii)
8906 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8908 nnn=num_cont_hb(ii)+1
8911 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8915 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8920 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8928 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8937 write (iout,'(a)') 'Contact function values after receive:'
8939 write (iout,'(2i3,50(1x,i3,5f6.3))')
8940 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8941 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8948 write (iout,'(a)') 'Contact function values:'
8950 write (iout,'(2i3,50(1x,i2,5f6.3))')
8951 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8952 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8958 C Remove the loop below after debugging !!!
8965 C Calculate the dipole-dipole interaction energies
8966 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8967 do i=iatel_s,iatel_e+1
8968 num_conti=num_cont_hb(i)
8977 C Calculate the local-electrostatic correlation terms
8978 c write (iout,*) "gradcorr5 in eello5 before loop"
8980 c write (iout,'(i5,3f10.5)')
8981 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8983 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8984 c write (iout,*) "corr loop i",i
8986 num_conti=num_cont_hb(i)
8987 num_conti1=num_cont_hb(i+1)
8994 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8995 c & ' jj=',jj,' kk=',kk
8996 c if (j1.eq.j+1 .or. j1.eq.j-1) then
8997 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8998 & .or. j.lt.0 .and. j1.gt.0) .and.
8999 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
9000 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
9001 C The system gains extra energy.
9003 sqd1=dsqrt(d_cont(jj,i))
9004 sqd2=dsqrt(d_cont(kk,i1))
9005 sred_geom = sqd1*sqd2
9006 IF (sred_geom.lt.cutoff_corr) THEN
9007 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
9009 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
9010 cd & ' jj=',jj,' kk=',kk
9011 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
9012 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
9014 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
9015 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
9018 cd write (iout,*) 'sred_geom=',sred_geom,
9019 cd & ' ekont=',ekont,' fprim=',fprimcont,
9020 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
9021 cd write (iout,*) "g_contij",g_contij
9022 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
9023 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
9024 call calc_eello(i,jp,i+1,jp1,jj,kk)
9025 if (wcorr4.gt.0.0d0)
9026 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
9027 CC & *fac_shield(i)**2*fac_shield(j)**2
9028 if (energy_dec.and.wcorr4.gt.0.0d0)
9029 1 write (iout,'(a6,4i5,0pf7.3)')
9030 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
9031 c write (iout,*) "gradcorr5 before eello5"
9033 c write (iout,'(i5,3f10.5)')
9034 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
9036 if (wcorr5.gt.0.0d0)
9037 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
9038 c write (iout,*) "gradcorr5 after eello5"
9040 c write (iout,'(i5,3f10.5)')
9041 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
9043 if (energy_dec.and.wcorr5.gt.0.0d0)
9044 1 write (iout,'(a6,4i5,0pf7.3)')
9045 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
9046 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
9047 cd write(2,*)'ijkl',i,jp,i+1,jp1
9048 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
9049 & .or. wturn6.eq.0.0d0))then
9050 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
9051 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
9052 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
9053 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
9054 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
9055 cd & 'ecorr6=',ecorr6
9056 cd write (iout,'(4e15.5)') sred_geom,
9057 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
9058 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
9059 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
9060 else if (wturn6.gt.0.0d0
9061 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
9062 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
9063 eturn6=eturn6+eello_turn6(i,jj,kk)
9064 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
9065 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
9066 cd write (2,*) 'multibody_eello:eturn6',eturn6
9075 num_cont_hb(i)=num_cont_hb_old(i)
9077 c write (iout,*) "gradcorr5 in eello5"
9079 c write (iout,'(i5,3f10.5)')
9080 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
9084 c------------------------------------------------------------------------------
9085 subroutine add_hb_contact_eello(ii,jj,itask)
9086 implicit real*8 (a-h,o-z)
9087 include "DIMENSIONS"
9088 include "COMMON.IOUNITS"
9091 parameter (max_cont=maxconts)
9092 parameter (max_dim=70)
9093 include "COMMON.CONTACTS"
9094 double precision zapas(max_dim,maxconts,max_fg_procs),
9095 & zapas_recv(max_dim,maxconts,max_fg_procs)
9096 common /przechowalnia/ zapas
9097 integer i,j,ii,jj,iproc,itask(4),nn
9098 c write (iout,*) "itask",itask
9101 if (iproc.gt.0) then
9102 do j=1,num_cont_hb(ii)
9104 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
9106 ncont_sent(iproc)=ncont_sent(iproc)+1
9107 nn=ncont_sent(iproc)
9108 zapas(1,nn,iproc)=ii
9109 zapas(2,nn,iproc)=jjc
9110 zapas(3,nn,iproc)=d_cont(j,ii)
9114 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
9119 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
9127 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
9139 c------------------------------------------------------------------------------
9140 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
9141 implicit real*8 (a-h,o-z)
9142 include 'DIMENSIONS'
9143 include 'COMMON.IOUNITS'
9144 include 'COMMON.DERIV'
9145 include 'COMMON.INTERACT'
9146 include 'COMMON.CONTACTS'
9147 include 'COMMON.SHIELD'
9148 include 'COMMON.CONTROL'
9149 double precision gx(3),gx1(3)
9152 C print *,"wchodze",fac_shield(i),shield_mode
9160 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
9162 C & fac_shield(i)**2*fac_shield(j)**2
9163 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
9164 C Following 4 lines for diagnostics.
9169 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
9170 c & 'Contacts ',i,j,
9171 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
9172 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
9174 C Calculate the multi-body contribution to energy.
9175 C ecorr=ecorr+ekont*ees
9176 C Calculate multi-body contributions to the gradient.
9177 coeffpees0pij=coeffp*ees0pij
9178 coeffmees0mij=coeffm*ees0mij
9179 coeffpees0pkl=coeffp*ees0pkl
9180 coeffmees0mkl=coeffm*ees0mkl
9182 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
9183 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
9184 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
9185 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
9186 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
9187 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
9188 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
9189 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
9190 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
9191 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
9192 & coeffmees0mij*gacontm_hb1(ll,kk,k))
9193 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
9194 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
9195 & coeffmees0mij*gacontm_hb2(ll,kk,k))
9196 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
9197 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
9198 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
9199 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
9200 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
9201 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
9202 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
9203 & coeffmees0mij*gacontm_hb3(ll,kk,k))
9204 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
9205 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
9206 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
9211 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
9212 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
9213 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
9214 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
9219 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
9220 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
9221 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
9222 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
9225 c write (iout,*) "ehbcorr",ekont*ees
9226 C print *,ekont,ees,i,k
9228 C now gradient over shielding
9230 if (shield_mode.gt.0) then
9233 C print *,i,j,fac_shield(i),fac_shield(j),
9234 C &fac_shield(k),fac_shield(l)
9235 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
9236 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
9237 do ilist=1,ishield_list(i)
9238 iresshield=shield_list(ilist,i)
9240 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
9242 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
9244 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
9245 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
9249 do ilist=1,ishield_list(j)
9250 iresshield=shield_list(ilist,j)
9252 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
9254 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
9256 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
9257 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
9262 do ilist=1,ishield_list(k)
9263 iresshield=shield_list(ilist,k)
9265 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
9267 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
9269 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
9270 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
9274 do ilist=1,ishield_list(l)
9275 iresshield=shield_list(ilist,l)
9277 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
9279 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
9281 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
9282 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
9286 C print *,gshieldx(m,iresshield)
9288 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
9289 & grad_shield(m,i)*ehbcorr/fac_shield(i)
9290 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
9291 & grad_shield(m,j)*ehbcorr/fac_shield(j)
9292 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
9293 & grad_shield(m,i)*ehbcorr/fac_shield(i)
9294 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
9295 & grad_shield(m,j)*ehbcorr/fac_shield(j)
9297 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
9298 & grad_shield(m,k)*ehbcorr/fac_shield(k)
9299 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
9300 & grad_shield(m,l)*ehbcorr/fac_shield(l)
9301 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
9302 & grad_shield(m,k)*ehbcorr/fac_shield(k)
9303 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
9304 & grad_shield(m,l)*ehbcorr/fac_shield(l)
9312 C---------------------------------------------------------------------------
9313 subroutine dipole(i,j,jj)
9314 implicit real*8 (a-h,o-z)
9315 include 'DIMENSIONS'
9316 include 'COMMON.IOUNITS'
9317 include 'COMMON.CHAIN'
9318 include 'COMMON.FFIELD'
9319 include 'COMMON.DERIV'
9320 include 'COMMON.INTERACT'
9321 include 'COMMON.CONTACTS'
9322 include 'COMMON.TORSION'
9323 include 'COMMON.VAR'
9324 include 'COMMON.GEO'
9325 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
9327 iti1 = itortyp(itype(i+1))
9328 if (j.lt.nres-1) then
9329 itj1 = itype2loc(itype(j+1))
9334 dipi(iii,1)=Ub2(iii,i)
9335 dipderi(iii)=Ub2der(iii,i)
9336 dipi(iii,2)=b1(iii,i+1)
9337 dipj(iii,1)=Ub2(iii,j)
9338 dipderj(iii)=Ub2der(iii,j)
9339 dipj(iii,2)=b1(iii,j+1)
9343 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
9346 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
9353 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
9357 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
9362 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
9363 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
9365 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
9367 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
9369 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
9374 C---------------------------------------------------------------------------
9375 subroutine calc_eello(i,j,k,l,jj,kk)
9377 C This subroutine computes matrices and vectors needed to calculate
9378 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
9380 implicit real*8 (a-h,o-z)
9381 include 'DIMENSIONS'
9382 include 'COMMON.IOUNITS'
9383 include 'COMMON.CHAIN'
9384 include 'COMMON.DERIV'
9385 include 'COMMON.INTERACT'
9386 include 'COMMON.CONTACTS'
9387 include 'COMMON.TORSION'
9388 include 'COMMON.VAR'
9389 include 'COMMON.GEO'
9390 include 'COMMON.FFIELD'
9391 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
9392 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
9395 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
9396 cd & ' jj=',jj,' kk=',kk
9397 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
9398 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
9399 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
9402 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
9403 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
9406 call transpose2(aa1(1,1),aa1t(1,1))
9407 call transpose2(aa2(1,1),aa2t(1,1))
9410 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
9411 & aa1tder(1,1,lll,kkk))
9412 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
9413 & aa2tder(1,1,lll,kkk))
9417 C parallel orientation of the two CA-CA-CA frames.
9419 iti=itype2loc(itype(i))
9423 itk1=itype2loc(itype(k+1))
9424 itj=itype2loc(itype(j))
9425 if (l.lt.nres-1) then
9426 itl1=itype2loc(itype(l+1))
9430 C A1 kernel(j+1) A2T
9432 cd write (iout,'(3f10.5,5x,3f10.5)')
9433 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
9435 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9436 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
9437 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9438 C Following matrices are needed only for 6-th order cumulants
9439 IF (wcorr6.gt.0.0d0) THEN
9440 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9441 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
9442 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9443 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9444 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
9445 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9446 & ADtEAderx(1,1,1,1,1,1))
9448 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9449 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
9450 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9451 & ADtEA1derx(1,1,1,1,1,1))
9453 C End 6-th order cumulants
9456 cd write (2,*) 'In calc_eello6'
9458 cd write (2,*) 'iii=',iii
9460 cd write (2,*) 'kkk=',kkk
9462 cd write (2,'(3(2f10.5),5x)')
9463 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9468 call transpose2(EUgder(1,1,k),auxmat(1,1))
9469 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9470 call transpose2(EUg(1,1,k),auxmat(1,1))
9471 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9472 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9476 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9477 & EAEAderx(1,1,lll,kkk,iii,1))
9481 C A1T kernel(i+1) A2
9482 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9483 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
9484 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9485 C Following matrices are needed only for 6-th order cumulants
9486 IF (wcorr6.gt.0.0d0) THEN
9487 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9488 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
9489 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9490 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9491 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
9492 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9493 & ADtEAderx(1,1,1,1,1,2))
9494 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
9495 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
9496 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9497 & ADtEA1derx(1,1,1,1,1,2))
9499 C End 6-th order cumulants
9500 call transpose2(EUgder(1,1,l),auxmat(1,1))
9501 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
9502 call transpose2(EUg(1,1,l),auxmat(1,1))
9503 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9504 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9508 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9509 & EAEAderx(1,1,lll,kkk,iii,2))
9514 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9515 C They are needed only when the fifth- or the sixth-order cumulants are
9517 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
9518 call transpose2(AEA(1,1,1),auxmat(1,1))
9519 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9520 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9521 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9522 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9523 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9524 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9525 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9526 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9527 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9528 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9529 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9530 call transpose2(AEA(1,1,2),auxmat(1,1))
9531 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
9532 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
9533 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
9534 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9535 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
9536 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
9537 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
9538 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
9539 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
9540 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
9541 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
9542 C Calculate the Cartesian derivatives of the vectors.
9546 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9547 call matvec2(auxmat(1,1),b1(1,i),
9548 & AEAb1derx(1,lll,kkk,iii,1,1))
9549 call matvec2(auxmat(1,1),Ub2(1,i),
9550 & AEAb2derx(1,lll,kkk,iii,1,1))
9551 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9552 & AEAb1derx(1,lll,kkk,iii,2,1))
9553 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9554 & AEAb2derx(1,lll,kkk,iii,2,1))
9555 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9556 call matvec2(auxmat(1,1),b1(1,j),
9557 & AEAb1derx(1,lll,kkk,iii,1,2))
9558 call matvec2(auxmat(1,1),Ub2(1,j),
9559 & AEAb2derx(1,lll,kkk,iii,1,2))
9560 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9561 & AEAb1derx(1,lll,kkk,iii,2,2))
9562 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
9563 & AEAb2derx(1,lll,kkk,iii,2,2))
9570 C Antiparallel orientation of the two CA-CA-CA frames.
9572 iti=itype2loc(itype(i))
9576 itk1=itype2loc(itype(k+1))
9577 itl=itype2loc(itype(l))
9578 itj=itype2loc(itype(j))
9579 if (j.lt.nres-1) then
9580 itj1=itype2loc(itype(j+1))
9584 C A2 kernel(j-1)T A1T
9585 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9586 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
9587 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9588 C Following matrices are needed only for 6-th order cumulants
9589 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9590 & j.eq.i+4 .and. l.eq.i+3)) THEN
9591 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9592 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
9593 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9594 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9595 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
9596 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9597 & ADtEAderx(1,1,1,1,1,1))
9598 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9599 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
9600 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9601 & ADtEA1derx(1,1,1,1,1,1))
9603 C End 6-th order cumulants
9604 call transpose2(EUgder(1,1,k),auxmat(1,1))
9605 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9606 call transpose2(EUg(1,1,k),auxmat(1,1))
9607 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9608 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9612 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9613 & EAEAderx(1,1,lll,kkk,iii,1))
9617 C A2T kernel(i+1)T A1
9618 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9619 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
9620 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9621 C Following matrices are needed only for 6-th order cumulants
9622 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9623 & j.eq.i+4 .and. l.eq.i+3)) THEN
9624 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9625 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
9626 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9627 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9628 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
9629 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9630 & ADtEAderx(1,1,1,1,1,2))
9631 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9632 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
9633 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9634 & ADtEA1derx(1,1,1,1,1,2))
9636 C End 6-th order cumulants
9637 call transpose2(EUgder(1,1,j),auxmat(1,1))
9638 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9639 call transpose2(EUg(1,1,j),auxmat(1,1))
9640 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9641 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9645 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9646 & EAEAderx(1,1,lll,kkk,iii,2))
9651 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9652 C They are needed only when the fifth- or the sixth-order cumulants are
9654 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
9655 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9656 call transpose2(AEA(1,1,1),auxmat(1,1))
9657 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9658 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9659 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9660 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9661 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9662 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9663 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9664 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9665 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9666 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9667 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9668 call transpose2(AEA(1,1,2),auxmat(1,1))
9669 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
9670 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9671 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9672 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9673 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
9674 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9675 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
9676 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
9677 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9678 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9679 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9680 C Calculate the Cartesian derivatives of the vectors.
9684 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9685 call matvec2(auxmat(1,1),b1(1,i),
9686 & AEAb1derx(1,lll,kkk,iii,1,1))
9687 call matvec2(auxmat(1,1),Ub2(1,i),
9688 & AEAb2derx(1,lll,kkk,iii,1,1))
9689 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9690 & AEAb1derx(1,lll,kkk,iii,2,1))
9691 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9692 & AEAb2derx(1,lll,kkk,iii,2,1))
9693 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9694 call matvec2(auxmat(1,1),b1(1,l),
9695 & AEAb1derx(1,lll,kkk,iii,1,2))
9696 call matvec2(auxmat(1,1),Ub2(1,l),
9697 & AEAb2derx(1,lll,kkk,iii,1,2))
9698 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
9699 & AEAb1derx(1,lll,kkk,iii,2,2))
9700 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
9701 & AEAb2derx(1,lll,kkk,iii,2,2))
9710 C---------------------------------------------------------------------------
9711 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
9712 & KK,KKderg,AKA,AKAderg,AKAderx)
9716 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
9717 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
9718 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
9723 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9725 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
9728 cd if (lprn) write (2,*) 'In kernel'
9730 cd if (lprn) write (2,*) 'kkk=',kkk
9732 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
9733 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9735 cd write (2,*) 'lll=',lll
9736 cd write (2,*) 'iii=1'
9738 cd write (2,'(3(2f10.5),5x)')
9739 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9742 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
9743 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9745 cd write (2,*) 'lll=',lll
9746 cd write (2,*) 'iii=2'
9748 cd write (2,'(3(2f10.5),5x)')
9749 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9756 C---------------------------------------------------------------------------
9757 double precision function eello4(i,j,k,l,jj,kk)
9758 implicit real*8 (a-h,o-z)
9759 include 'DIMENSIONS'
9760 include 'COMMON.IOUNITS'
9761 include 'COMMON.CHAIN'
9762 include 'COMMON.DERIV'
9763 include 'COMMON.INTERACT'
9764 include 'COMMON.CONTACTS'
9765 include 'COMMON.TORSION'
9766 include 'COMMON.VAR'
9767 include 'COMMON.GEO'
9768 double precision pizda(2,2),ggg1(3),ggg2(3)
9769 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9773 cd print *,'eello4:',i,j,k,l,jj,kk
9774 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9775 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9776 cold eij=facont_hb(jj,i)
9777 cold ekl=facont_hb(kk,k)
9779 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9780 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9781 gcorr_loc(k-1)=gcorr_loc(k-1)
9782 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9784 gcorr_loc(l-1)=gcorr_loc(l-1)
9785 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9787 gcorr_loc(j-1)=gcorr_loc(j-1)
9788 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9793 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9794 & -EAEAderx(2,2,lll,kkk,iii,1)
9795 cd derx(lll,kkk,iii)=0.0d0
9799 cd gcorr_loc(l-1)=0.0d0
9800 cd gcorr_loc(j-1)=0.0d0
9801 cd gcorr_loc(k-1)=0.0d0
9803 cd write (iout,*)'Contacts have occurred for peptide groups',
9804 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9805 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9806 if (j.lt.nres-1) then
9813 if (l.lt.nres-1) then
9821 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9822 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9823 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9824 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9825 cgrad ghalf=0.5d0*ggg1(ll)
9826 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9827 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9828 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9829 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9830 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9831 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9832 cgrad ghalf=0.5d0*ggg2(ll)
9833 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9834 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9835 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9836 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9837 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9838 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9842 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9847 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9852 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9857 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9861 cd write (2,*) iii,gcorr_loc(iii)
9864 cd write (2,*) 'ekont',ekont
9865 cd write (iout,*) 'eello4',ekont*eel4
9868 C---------------------------------------------------------------------------
9869 double precision function eello5(i,j,k,l,jj,kk)
9870 implicit real*8 (a-h,o-z)
9871 include 'DIMENSIONS'
9872 include 'COMMON.IOUNITS'
9873 include 'COMMON.CHAIN'
9874 include 'COMMON.DERIV'
9875 include 'COMMON.INTERACT'
9876 include 'COMMON.CONTACTS'
9877 include 'COMMON.TORSION'
9878 include 'COMMON.VAR'
9879 include 'COMMON.GEO'
9880 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9881 double precision ggg1(3),ggg2(3)
9882 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9887 C /l\ / \ \ / \ / \ / C
9888 C / \ / \ \ / \ / \ / C
9889 C j| o |l1 | o | o| o | | o |o C
9890 C \ |/k\| |/ \| / |/ \| |/ \| C
9891 C \i/ \ / \ / / \ / \ C
9893 C (I) (II) (III) (IV) C
9895 C eello5_1 eello5_2 eello5_3 eello5_4 C
9897 C Antiparallel chains C
9900 C /j\ / \ \ / \ / \ / C
9901 C / \ / \ \ / \ / \ / C
9902 C j1| o |l | o | o| o | | o |o C
9903 C \ |/k\| |/ \| / |/ \| |/ \| C
9904 C \i/ \ / \ / / \ / \ C
9906 C (I) (II) (III) (IV) C
9908 C eello5_1 eello5_2 eello5_3 eello5_4 C
9910 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9912 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9913 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9918 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9920 itk=itype2loc(itype(k))
9921 itl=itype2loc(itype(l))
9922 itj=itype2loc(itype(j))
9927 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9928 cd & eel5_3_num,eel5_4_num)
9932 derx(lll,kkk,iii)=0.0d0
9936 cd eij=facont_hb(jj,i)
9937 cd ekl=facont_hb(kk,k)
9939 cd write (iout,*)'Contacts have occurred for peptide groups',
9940 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9942 C Contribution from the graph I.
9943 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9944 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9945 call transpose2(EUg(1,1,k),auxmat(1,1))
9946 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9947 vv(1)=pizda(1,1)-pizda(2,2)
9948 vv(2)=pizda(1,2)+pizda(2,1)
9949 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9950 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9951 C Explicit gradient in virtual-dihedral angles.
9952 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9953 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9954 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9955 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9956 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9957 vv(1)=pizda(1,1)-pizda(2,2)
9958 vv(2)=pizda(1,2)+pizda(2,1)
9959 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9960 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9961 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9962 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9963 vv(1)=pizda(1,1)-pizda(2,2)
9964 vv(2)=pizda(1,2)+pizda(2,1)
9966 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9967 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9968 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9970 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9971 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9972 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9974 C Cartesian gradient
9978 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
9980 vv(1)=pizda(1,1)-pizda(2,2)
9981 vv(2)=pizda(1,2)+pizda(2,1)
9982 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9983 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
9984 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9990 C Contribution from graph II
9991 call transpose2(EE(1,1,k),auxmat(1,1))
9992 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9993 vv(1)=pizda(1,1)+pizda(2,2)
9994 vv(2)=pizda(2,1)-pizda(1,2)
9995 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
9996 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9997 C Explicit gradient in virtual-dihedral angles.
9998 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9999 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
10000 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
10001 vv(1)=pizda(1,1)+pizda(2,2)
10002 vv(2)=pizda(2,1)-pizda(1,2)
10004 g_corr5_loc(l-1)=g_corr5_loc(l-1)
10005 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
10006 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
10008 g_corr5_loc(j-1)=g_corr5_loc(j-1)
10009 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
10010 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
10012 C Cartesian gradient
10016 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
10018 vv(1)=pizda(1,1)+pizda(2,2)
10019 vv(2)=pizda(2,1)-pizda(1,2)
10020 derx(lll,kkk,iii)=derx(lll,kkk,iii)
10021 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
10022 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
10030 C Parallel orientation
10031 C Contribution from graph III
10032 call transpose2(EUg(1,1,l),auxmat(1,1))
10033 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
10034 vv(1)=pizda(1,1)-pizda(2,2)
10035 vv(2)=pizda(1,2)+pizda(2,1)
10036 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
10037 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
10038 C Explicit gradient in virtual-dihedral angles.
10039 g_corr5_loc(j-1)=g_corr5_loc(j-1)
10040 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
10041 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
10042 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
10043 vv(1)=pizda(1,1)-pizda(2,2)
10044 vv(2)=pizda(1,2)+pizda(2,1)
10045 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10046 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
10047 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
10048 call transpose2(EUgder(1,1,l),auxmat1(1,1))
10049 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
10050 vv(1)=pizda(1,1)-pizda(2,2)
10051 vv(2)=pizda(1,2)+pizda(2,1)
10052 g_corr5_loc(l-1)=g_corr5_loc(l-1)
10053 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
10054 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
10055 C Cartesian gradient
10059 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
10061 vv(1)=pizda(1,1)-pizda(2,2)
10062 vv(2)=pizda(1,2)+pizda(2,1)
10063 derx(lll,kkk,iii)=derx(lll,kkk,iii)
10064 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
10065 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
10070 C Contribution from graph IV
10072 call transpose2(EE(1,1,l),auxmat(1,1))
10073 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
10074 vv(1)=pizda(1,1)+pizda(2,2)
10075 vv(2)=pizda(2,1)-pizda(1,2)
10076 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
10077 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
10078 C Explicit gradient in virtual-dihedral angles.
10079 g_corr5_loc(l-1)=g_corr5_loc(l-1)
10080 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
10081 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
10082 vv(1)=pizda(1,1)+pizda(2,2)
10083 vv(2)=pizda(2,1)-pizda(1,2)
10084 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10085 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
10086 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
10087 C Cartesian gradient
10091 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
10093 vv(1)=pizda(1,1)+pizda(2,2)
10094 vv(2)=pizda(2,1)-pizda(1,2)
10095 derx(lll,kkk,iii)=derx(lll,kkk,iii)
10096 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
10097 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
10102 C Antiparallel orientation
10103 C Contribution from graph III
10105 call transpose2(EUg(1,1,j),auxmat(1,1))
10106 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
10107 vv(1)=pizda(1,1)-pizda(2,2)
10108 vv(2)=pizda(1,2)+pizda(2,1)
10109 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
10110 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
10111 C Explicit gradient in virtual-dihedral angles.
10112 g_corr5_loc(l-1)=g_corr5_loc(l-1)
10113 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
10114 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
10115 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
10116 vv(1)=pizda(1,1)-pizda(2,2)
10117 vv(2)=pizda(1,2)+pizda(2,1)
10118 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10119 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
10120 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
10121 call transpose2(EUgder(1,1,j),auxmat1(1,1))
10122 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
10123 vv(1)=pizda(1,1)-pizda(2,2)
10124 vv(2)=pizda(1,2)+pizda(2,1)
10125 g_corr5_loc(j-1)=g_corr5_loc(j-1)
10126 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
10127 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
10128 C Cartesian gradient
10132 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
10134 vv(1)=pizda(1,1)-pizda(2,2)
10135 vv(2)=pizda(1,2)+pizda(2,1)
10136 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
10137 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
10138 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
10143 C Contribution from graph IV
10145 call transpose2(EE(1,1,j),auxmat(1,1))
10146 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
10147 vv(1)=pizda(1,1)+pizda(2,2)
10148 vv(2)=pizda(2,1)-pizda(1,2)
10149 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
10150 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
10151 C Explicit gradient in virtual-dihedral angles.
10152 g_corr5_loc(j-1)=g_corr5_loc(j-1)
10153 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
10154 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
10155 vv(1)=pizda(1,1)+pizda(2,2)
10156 vv(2)=pizda(2,1)-pizda(1,2)
10157 g_corr5_loc(k-1)=g_corr5_loc(k-1)
10158 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
10159 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
10160 C Cartesian gradient
10164 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
10166 vv(1)=pizda(1,1)+pizda(2,2)
10167 vv(2)=pizda(2,1)-pizda(1,2)
10168 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
10169 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
10170 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
10176 eel5=eello5_1+eello5_2+eello5_3+eello5_4
10177 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
10178 cd write (2,*) 'ijkl',i,j,k,l
10179 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
10180 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
10182 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
10183 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
10184 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
10185 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
10186 if (j.lt.nres-1) then
10193 if (l.lt.nres-1) then
10203 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
10204 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
10205 C summed up outside the subrouine as for the other subroutines
10206 C handling long-range interactions. The old code is commented out
10207 C with "cgrad" to keep track of changes.
10209 cgrad ggg1(ll)=eel5*g_contij(ll,1)
10210 cgrad ggg2(ll)=eel5*g_contij(ll,2)
10211 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
10212 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
10213 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
10214 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
10215 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
10216 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
10217 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
10218 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
10220 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
10221 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
10222 cgrad ghalf=0.5d0*ggg1(ll)
10224 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
10225 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
10226 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
10227 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
10228 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
10229 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
10230 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
10231 cgrad ghalf=0.5d0*ggg2(ll)
10233 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
10234 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
10235 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
10236 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
10237 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
10238 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
10243 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
10244 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
10249 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
10250 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
10256 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
10261 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
10265 cd write (2,*) iii,g_corr5_loc(iii)
10268 cd write (2,*) 'ekont',ekont
10269 cd write (iout,*) 'eello5',ekont*eel5
10272 c--------------------------------------------------------------------------
10273 double precision function eello6(i,j,k,l,jj,kk)
10274 implicit real*8 (a-h,o-z)
10275 include 'DIMENSIONS'
10276 include 'COMMON.IOUNITS'
10277 include 'COMMON.CHAIN'
10278 include 'COMMON.DERIV'
10279 include 'COMMON.INTERACT'
10280 include 'COMMON.CONTACTS'
10281 include 'COMMON.TORSION'
10282 include 'COMMON.VAR'
10283 include 'COMMON.GEO'
10284 include 'COMMON.FFIELD'
10285 double precision ggg1(3),ggg2(3)
10286 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10291 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10299 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
10300 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
10304 derx(lll,kkk,iii)=0.0d0
10308 cd eij=facont_hb(jj,i)
10309 cd ekl=facont_hb(kk,k)
10315 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
10316 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
10317 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
10318 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
10319 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
10320 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
10322 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
10323 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
10324 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
10325 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
10326 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
10327 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10331 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
10333 C If turn contributions are considered, they will be handled separately.
10334 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
10335 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
10336 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
10337 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
10338 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
10339 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
10340 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
10342 if (j.lt.nres-1) then
10349 if (l.lt.nres-1) then
10357 cgrad ggg1(ll)=eel6*g_contij(ll,1)
10358 cgrad ggg2(ll)=eel6*g_contij(ll,2)
10359 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
10360 cgrad ghalf=0.5d0*ggg1(ll)
10362 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
10363 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
10364 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
10365 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
10366 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
10367 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
10368 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
10369 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
10370 cgrad ghalf=0.5d0*ggg2(ll)
10371 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
10373 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
10374 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
10375 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
10376 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
10377 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
10378 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
10383 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
10384 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
10389 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
10390 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
10396 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
10401 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
10405 cd write (2,*) iii,g_corr6_loc(iii)
10408 cd write (2,*) 'ekont',ekont
10409 cd write (iout,*) 'eello6',ekont*eel6
10412 c--------------------------------------------------------------------------
10413 double precision function eello6_graph1(i,j,k,l,imat,swap)
10414 implicit real*8 (a-h,o-z)
10415 include 'DIMENSIONS'
10416 include 'COMMON.IOUNITS'
10417 include 'COMMON.CHAIN'
10418 include 'COMMON.DERIV'
10419 include 'COMMON.INTERACT'
10420 include 'COMMON.CONTACTS'
10421 include 'COMMON.TORSION'
10422 include 'COMMON.VAR'
10423 include 'COMMON.GEO'
10424 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
10427 common /kutas/ lprn
10428 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10430 C Parallel Antiparallel C
10436 C \ j|/k\| / \ |/k\|l / C
10437 C \ / \ / \ / \ / C
10441 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10442 itk=itype2loc(itype(k))
10443 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
10444 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
10445 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
10446 call transpose2(EUgC(1,1,k),auxmat(1,1))
10447 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10448 vv1(1)=pizda1(1,1)-pizda1(2,2)
10449 vv1(2)=pizda1(1,2)+pizda1(2,1)
10450 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10451 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
10452 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
10453 s5=scalar2(vv(1),Dtobr2(1,i))
10454 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
10455 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
10456 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
10457 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
10458 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
10459 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
10460 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
10461 & +scalar2(vv(1),Dtobr2der(1,i)))
10462 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
10463 vv1(1)=pizda1(1,1)-pizda1(2,2)
10464 vv1(2)=pizda1(1,2)+pizda1(2,1)
10465 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
10466 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
10468 g_corr6_loc(l-1)=g_corr6_loc(l-1)
10469 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
10470 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
10471 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
10472 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10474 g_corr6_loc(j-1)=g_corr6_loc(j-1)
10475 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
10476 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
10477 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
10478 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10480 call transpose2(EUgCder(1,1,k),auxmat(1,1))
10481 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10482 vv1(1)=pizda1(1,1)-pizda1(2,2)
10483 vv1(2)=pizda1(1,2)+pizda1(2,1)
10484 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
10485 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
10486 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
10487 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
10496 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
10497 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
10498 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
10499 call transpose2(EUgC(1,1,k),auxmat(1,1))
10500 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10502 vv1(1)=pizda1(1,1)-pizda1(2,2)
10503 vv1(2)=pizda1(1,2)+pizda1(2,1)
10504 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10505 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
10506 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
10507 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
10508 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
10509 s5=scalar2(vv(1),Dtobr2(1,i))
10510 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
10516 c----------------------------------------------------------------------------
10517 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
10518 implicit real*8 (a-h,o-z)
10519 include 'DIMENSIONS'
10520 include 'COMMON.IOUNITS'
10521 include 'COMMON.CHAIN'
10522 include 'COMMON.DERIV'
10523 include 'COMMON.INTERACT'
10524 include 'COMMON.CONTACTS'
10525 include 'COMMON.TORSION'
10526 include 'COMMON.VAR'
10527 include 'COMMON.GEO'
10529 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10530 & auxvec1(2),auxvec2(2),auxmat1(2,2)
10532 common /kutas/ lprn
10533 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10535 C Parallel Antiparallel C
10541 C \ j|/k\| \ |/k\|l C
10546 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10547 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
10548 C AL 7/4/01 s1 would occur in the sixth-order moment,
10549 C but not in a cluster cumulant
10551 s1=dip(1,jj,i)*dip(1,kk,k)
10553 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
10554 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10555 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
10556 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
10557 call transpose2(EUg(1,1,k),auxmat(1,1))
10558 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
10559 vv(1)=pizda(1,1)-pizda(2,2)
10560 vv(2)=pizda(1,2)+pizda(2,1)
10561 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10562 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10564 eello6_graph2=-(s1+s2+s3+s4)
10566 eello6_graph2=-(s2+s3+s4)
10568 c eello6_graph2=-s3
10569 C Derivatives in gamma(i-1)
10572 s1=dipderg(1,jj,i)*dip(1,kk,k)
10574 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10575 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
10576 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10577 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10579 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10581 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10583 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
10585 C Derivatives in gamma(k-1)
10587 s1=dip(1,jj,i)*dipderg(1,kk,k)
10589 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
10590 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10591 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
10592 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10593 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10594 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
10595 vv(1)=pizda(1,1)-pizda(2,2)
10596 vv(2)=pizda(1,2)+pizda(2,1)
10597 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10599 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10601 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10603 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
10604 C Derivatives in gamma(j-1) or gamma(l-1)
10607 s1=dipderg(3,jj,i)*dip(1,kk,k)
10609 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
10610 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10611 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
10612 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
10613 vv(1)=pizda(1,1)-pizda(2,2)
10614 vv(2)=pizda(1,2)+pizda(2,1)
10615 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10618 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10620 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10623 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10624 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10626 C Derivatives in gamma(l-1) or gamma(j-1)
10629 s1=dip(1,jj,i)*dipderg(3,kk,k)
10631 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10632 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10633 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10634 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10635 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10636 vv(1)=pizda(1,1)-pizda(2,2)
10637 vv(2)=pizda(1,2)+pizda(2,1)
10638 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10641 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10643 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10646 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10647 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10649 C Cartesian derivatives.
10651 write (2,*) 'In eello6_graph2'
10653 write (2,*) 'iii=',iii
10655 write (2,*) 'kkk=',kkk
10657 write (2,'(3(2f10.5),5x)')
10658 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10668 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10670 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10673 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
10675 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10676 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
10678 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10679 call transpose2(EUg(1,1,k),auxmat(1,1))
10680 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
10682 vv(1)=pizda(1,1)-pizda(2,2)
10683 vv(2)=pizda(1,2)+pizda(2,1)
10684 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10685 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10687 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10689 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10692 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10694 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10701 c----------------------------------------------------------------------------
10702 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
10703 implicit real*8 (a-h,o-z)
10704 include 'DIMENSIONS'
10705 include 'COMMON.IOUNITS'
10706 include 'COMMON.CHAIN'
10707 include 'COMMON.DERIV'
10708 include 'COMMON.INTERACT'
10709 include 'COMMON.CONTACTS'
10710 include 'COMMON.TORSION'
10711 include 'COMMON.VAR'
10712 include 'COMMON.GEO'
10713 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
10715 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10717 C Parallel Antiparallel C
10722 C /| o |o o| o |\ C
10723 C j|/k\| / |/k\|l / C
10728 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10730 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10731 C energy moment and not to the cluster cumulant.
10732 iti=itortyp(itype(i))
10733 if (j.lt.nres-1) then
10734 itj1=itype2loc(itype(j+1))
10738 itk=itype2loc(itype(k))
10739 itk1=itype2loc(itype(k+1))
10740 if (l.lt.nres-1) then
10741 itl1=itype2loc(itype(l+1))
10746 s1=dip(4,jj,i)*dip(4,kk,k)
10748 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
10749 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10750 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
10751 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10752 call transpose2(EE(1,1,k),auxmat(1,1))
10753 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10754 vv(1)=pizda(1,1)+pizda(2,2)
10755 vv(2)=pizda(2,1)-pizda(1,2)
10756 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10757 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10758 cd & "sum",-(s2+s3+s4)
10760 eello6_graph3=-(s1+s2+s3+s4)
10762 eello6_graph3=-(s2+s3+s4)
10764 c eello6_graph3=-s4
10765 C Derivatives in gamma(k-1)
10766 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
10767 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10768 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10769 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10770 C Derivatives in gamma(l-1)
10771 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
10772 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10773 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10774 vv(1)=pizda(1,1)+pizda(2,2)
10775 vv(2)=pizda(2,1)-pizda(1,2)
10776 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10777 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10778 C Cartesian derivatives.
10784 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10786 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10789 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
10791 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10792 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
10794 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10795 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
10797 vv(1)=pizda(1,1)+pizda(2,2)
10798 vv(2)=pizda(2,1)-pizda(1,2)
10799 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10801 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10803 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10806 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10808 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10810 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10816 c----------------------------------------------------------------------------
10817 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10818 implicit real*8 (a-h,o-z)
10819 include 'DIMENSIONS'
10820 include 'COMMON.IOUNITS'
10821 include 'COMMON.CHAIN'
10822 include 'COMMON.DERIV'
10823 include 'COMMON.INTERACT'
10824 include 'COMMON.CONTACTS'
10825 include 'COMMON.TORSION'
10826 include 'COMMON.VAR'
10827 include 'COMMON.GEO'
10828 include 'COMMON.FFIELD'
10829 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10830 & auxvec1(2),auxmat1(2,2)
10832 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10834 C Parallel Antiparallel C
10839 C /| o |o o| o |\ C
10840 C \ j|/k\| \ |/k\|l C
10845 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10847 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10848 C energy moment and not to the cluster cumulant.
10849 cd write (2,*) 'eello_graph4: wturn6',wturn6
10850 iti=itype2loc(itype(i))
10851 itj=itype2loc(itype(j))
10852 if (j.lt.nres-1) then
10853 itj1=itype2loc(itype(j+1))
10857 itk=itype2loc(itype(k))
10858 if (k.lt.nres-1) then
10859 itk1=itype2loc(itype(k+1))
10863 itl=itype2loc(itype(l))
10864 if (l.lt.nres-1) then
10865 itl1=itype2loc(itype(l+1))
10869 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10870 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10871 cd & ' itl',itl,' itl1',itl1
10873 if (imat.eq.1) then
10874 s1=dip(3,jj,i)*dip(3,kk,k)
10876 s1=dip(2,jj,j)*dip(2,kk,l)
10879 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10880 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10882 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
10883 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10885 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
10886 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10888 call transpose2(EUg(1,1,k),auxmat(1,1))
10889 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10890 vv(1)=pizda(1,1)-pizda(2,2)
10891 vv(2)=pizda(2,1)+pizda(1,2)
10892 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10893 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10895 eello6_graph4=-(s1+s2+s3+s4)
10897 eello6_graph4=-(s2+s3+s4)
10899 C Derivatives in gamma(i-1)
10902 if (imat.eq.1) then
10903 s1=dipderg(2,jj,i)*dip(3,kk,k)
10905 s1=dipderg(4,jj,j)*dip(2,kk,l)
10908 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10910 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
10911 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10913 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
10914 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10916 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10917 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10918 cd write (2,*) 'turn6 derivatives'
10920 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10922 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10926 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10928 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10932 C Derivatives in gamma(k-1)
10934 if (imat.eq.1) then
10935 s1=dip(3,jj,i)*dipderg(2,kk,k)
10937 s1=dip(2,jj,j)*dipderg(4,kk,l)
10940 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10941 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10943 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
10944 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10946 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
10947 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10949 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10950 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10951 vv(1)=pizda(1,1)-pizda(2,2)
10952 vv(2)=pizda(2,1)+pizda(1,2)
10953 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10954 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10956 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10958 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10962 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10964 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10967 C Derivatives in gamma(j-1) or gamma(l-1)
10968 if (l.eq.j+1 .and. l.gt.1) then
10969 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10970 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10971 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10972 vv(1)=pizda(1,1)-pizda(2,2)
10973 vv(2)=pizda(2,1)+pizda(1,2)
10974 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10975 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10976 else if (j.gt.1) then
10977 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10978 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10979 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10980 vv(1)=pizda(1,1)-pizda(2,2)
10981 vv(2)=pizda(2,1)+pizda(1,2)
10982 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10983 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10984 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10986 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10989 C Cartesian derivatives.
10995 if (imat.eq.1) then
10996 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10998 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
11001 if (imat.eq.1) then
11002 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
11004 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
11008 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
11010 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
11012 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
11013 & b1(1,j+1),auxvec(1))
11014 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
11016 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
11017 & b1(1,l+1),auxvec(1))
11018 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
11020 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
11022 vv(1)=pizda(1,1)-pizda(2,2)
11023 vv(2)=pizda(2,1)+pizda(1,2)
11024 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
11026 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
11028 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
11031 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
11034 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
11037 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
11039 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
11041 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
11045 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
11047 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
11050 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
11052 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
11060 c----------------------------------------------------------------------------
11061 double precision function eello_turn6(i,jj,kk)
11062 implicit real*8 (a-h,o-z)
11063 include 'DIMENSIONS'
11064 include 'COMMON.IOUNITS'
11065 include 'COMMON.CHAIN'
11066 include 'COMMON.DERIV'
11067 include 'COMMON.INTERACT'
11068 include 'COMMON.CONTACTS'
11069 include 'COMMON.TORSION'
11070 include 'COMMON.VAR'
11071 include 'COMMON.GEO'
11072 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
11073 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
11075 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
11076 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
11077 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
11078 C the respective energy moment and not to the cluster cumulant.
11087 iti=itype2loc(itype(i))
11088 itk=itype2loc(itype(k))
11089 itk1=itype2loc(itype(k+1))
11090 itl=itype2loc(itype(l))
11091 itj=itype2loc(itype(j))
11092 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
11093 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
11094 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
11099 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
11101 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
11105 derx_turn(lll,kkk,iii)=0.0d0
11112 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
11114 cd write (2,*) 'eello6_5',eello6_5
11116 call transpose2(AEA(1,1,1),auxmat(1,1))
11117 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
11118 ss1=scalar2(Ub2(1,i+2),b1(1,l))
11119 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
11121 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
11122 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
11123 s2 = scalar2(b1(1,k),vtemp1(1))
11125 call transpose2(AEA(1,1,2),atemp(1,1))
11126 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
11127 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
11128 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
11130 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
11131 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
11132 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
11134 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
11135 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
11136 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
11137 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
11138 ss13 = scalar2(b1(1,k),vtemp4(1))
11139 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
11141 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
11147 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
11148 C Derivatives in gamma(i+2)
11152 call transpose2(AEA(1,1,1),auxmatd(1,1))
11153 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
11154 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
11155 call transpose2(AEAderg(1,1,2),atempd(1,1))
11156 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
11157 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
11159 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
11160 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
11161 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
11167 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
11168 C Derivatives in gamma(i+3)
11170 call transpose2(AEA(1,1,1),auxmatd(1,1))
11171 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
11172 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
11173 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
11175 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
11176 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
11177 s2d = scalar2(b1(1,k),vtemp1d(1))
11179 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
11180 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
11182 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
11184 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
11185 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
11186 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
11194 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
11195 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
11197 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
11198 & -0.5d0*ekont*(s2d+s12d)
11200 C Derivatives in gamma(i+4)
11201 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
11202 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
11203 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
11205 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
11206 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
11207 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
11215 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
11217 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
11219 C Derivatives in gamma(i+5)
11221 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
11222 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
11223 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
11225 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
11226 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
11227 s2d = scalar2(b1(1,k),vtemp1d(1))
11229 call transpose2(AEA(1,1,2),atempd(1,1))
11230 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
11231 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
11233 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
11234 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
11236 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
11237 ss13d = scalar2(b1(1,k),vtemp4d(1))
11238 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
11246 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
11247 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
11249 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
11250 & -0.5d0*ekont*(s2d+s12d)
11252 C Cartesian derivatives
11257 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
11258 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
11259 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
11261 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
11262 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
11264 s2d = scalar2(b1(1,k),vtemp1d(1))
11266 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
11267 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
11268 s8d = -(atempd(1,1)+atempd(2,2))*
11269 & scalar2(cc(1,1,itl),vtemp2(1))
11271 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
11273 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
11274 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
11281 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
11282 & - 0.5d0*(s1d+s2d)
11284 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
11288 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
11289 & - 0.5d0*(s8d+s12d)
11291 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
11300 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
11301 & achuj_tempd(1,1))
11302 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
11303 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
11304 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
11305 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
11306 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
11308 ss13d = scalar2(b1(1,k),vtemp4d(1))
11309 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
11310 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
11314 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
11315 cd & 16*eel_turn6_num
11317 if (j.lt.nres-1) then
11324 if (l.lt.nres-1) then
11332 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
11333 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
11334 cgrad ghalf=0.5d0*ggg1(ll)
11336 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
11337 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
11338 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
11339 & +ekont*derx_turn(ll,2,1)
11340 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
11341 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
11342 & +ekont*derx_turn(ll,4,1)
11343 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
11344 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
11345 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
11346 cgrad ghalf=0.5d0*ggg2(ll)
11348 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
11349 & +ekont*derx_turn(ll,2,2)
11350 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
11351 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
11352 & +ekont*derx_turn(ll,4,2)
11353 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
11354 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
11355 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
11360 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
11365 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
11371 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
11376 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
11380 cd write (2,*) iii,g_corr6_loc(iii)
11382 eello_turn6=ekont*eel_turn6
11383 cd write (2,*) 'ekont',ekont
11384 cd write (2,*) 'eel_turn6',ekont*eel_turn6
11388 C-----------------------------------------------------------------------------
11389 double precision function scalar(u,v)
11390 !DIR$ INLINEALWAYS scalar
11392 cDEC$ ATTRIBUTES FORCEINLINE::scalar
11395 double precision u(3),v(3)
11396 cd double precision sc
11404 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
11407 crc-------------------------------------------------
11408 SUBROUTINE MATVEC2(A1,V1,V2)
11409 !DIR$ INLINEALWAYS MATVEC2
11411 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
11413 implicit real*8 (a-h,o-z)
11414 include 'DIMENSIONS'
11415 DIMENSION A1(2,2),V1(2),V2(2)
11419 c 3 VI=VI+A1(I,K)*V1(K)
11423 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
11424 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
11429 C---------------------------------------
11430 SUBROUTINE MATMAT2(A1,A2,A3)
11432 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
11434 implicit real*8 (a-h,o-z)
11435 include 'DIMENSIONS'
11436 DIMENSION A1(2,2),A2(2,2),A3(2,2)
11437 c DIMENSION AI3(2,2)
11441 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
11447 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
11448 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
11449 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
11450 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
11458 c-------------------------------------------------------------------------
11459 double precision function scalar2(u,v)
11460 !DIR$ INLINEALWAYS scalar2
11462 double precision u(2),v(2)
11463 double precision sc
11465 scalar2=u(1)*v(1)+u(2)*v(2)
11469 C-----------------------------------------------------------------------------
11471 subroutine transpose2(a,at)
11472 !DIR$ INLINEALWAYS transpose2
11474 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
11477 double precision a(2,2),at(2,2)
11484 c--------------------------------------------------------------------------
11485 subroutine transpose(n,a,at)
11488 double precision a(n,n),at(n,n)
11496 C---------------------------------------------------------------------------
11497 subroutine prodmat3(a1,a2,kk,transp,prod)
11498 !DIR$ INLINEALWAYS prodmat3
11500 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
11504 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
11506 crc double precision auxmat(2,2),prod_(2,2)
11509 crc call transpose2(kk(1,1),auxmat(1,1))
11510 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
11511 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11513 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
11514 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
11515 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
11516 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
11517 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
11518 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
11519 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
11520 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
11523 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
11524 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11526 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
11527 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
11528 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
11529 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
11530 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
11531 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
11532 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
11533 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
11536 c call transpose2(a2(1,1),a2t(1,1))
11539 crc print *,((prod_(i,j),i=1,2),j=1,2)
11540 crc print *,((prod(i,j),i=1,2),j=1,2)
11544 CCC----------------------------------------------
11545 subroutine Eliptransfer(eliptran)
11546 implicit real*8 (a-h,o-z)
11547 include 'DIMENSIONS'
11548 include 'COMMON.GEO'
11549 include 'COMMON.VAR'
11550 include 'COMMON.LOCAL'
11551 include 'COMMON.CHAIN'
11552 include 'COMMON.DERIV'
11553 include 'COMMON.NAMES'
11554 include 'COMMON.INTERACT'
11555 include 'COMMON.IOUNITS'
11556 include 'COMMON.CALC'
11557 include 'COMMON.CONTROL'
11558 include 'COMMON.SPLITELE'
11559 include 'COMMON.SBRIDGE'
11560 C this is done by Adasko
11561 C print *,"wchodze"
11562 C structure of box:
11564 C--bordliptop-- buffore starts
11565 C--bufliptop--- here true lipid starts
11567 C--buflipbot--- lipid ends buffore starts
11568 C--bordlipbot--buffore ends
11570 do i=ilip_start,ilip_end
11572 if (itype(i).eq.ntyp1) cycle
11574 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
11575 if (positi.le.0.0) positi=positi+boxzsize
11577 C first for peptide groups
11578 c for each residue check if it is in lipid or lipid water border area
11579 if ((positi.gt.bordlipbot)
11580 &.and.(positi.lt.bordliptop)) then
11581 C the energy transfer exist
11582 if (positi.lt.buflipbot) then
11583 C what fraction I am in
11585 & ((positi-bordlipbot)/lipbufthick)
11586 C lipbufthick is thickenes of lipid buffore
11587 sslip=sscalelip(fracinbuf)
11588 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11589 eliptran=eliptran+sslip*pepliptran
11590 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11591 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11592 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11594 C print *,"doing sccale for lower part"
11595 C print *,i,sslip,fracinbuf,ssgradlip
11596 elseif (positi.gt.bufliptop) then
11597 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
11598 sslip=sscalelip(fracinbuf)
11599 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11600 eliptran=eliptran+sslip*pepliptran
11601 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
11602 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
11603 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
11604 C print *, "doing sscalefor top part"
11605 C print *,i,sslip,fracinbuf,ssgradlip
11607 eliptran=eliptran+pepliptran
11608 C print *,"I am in true lipid"
11611 C eliptran=elpitran+0.0 ! I am in water
11614 C print *, "nic nie bylo w lipidzie?"
11615 C now multiply all by the peptide group transfer factor
11616 C eliptran=eliptran*pepliptran
11617 C now the same for side chains
11619 do i=ilip_start,ilip_end
11620 if (itype(i).eq.ntyp1) cycle
11621 positi=(mod(c(3,i+nres),boxzsize))
11622 if (positi.le.0) positi=positi+boxzsize
11623 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
11624 c for each residue check if it is in lipid or lipid water border area
11625 C respos=mod(c(3,i+nres),boxzsize)
11626 C print *,positi,bordlipbot,buflipbot
11627 if ((positi.gt.bordlipbot)
11628 & .and.(positi.lt.bordliptop)) then
11629 C the energy transfer exist
11630 if (positi.lt.buflipbot) then
11632 & ((positi-bordlipbot)/lipbufthick)
11633 C lipbufthick is thickenes of lipid buffore
11634 sslip=sscalelip(fracinbuf)
11635 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
11636 eliptran=eliptran+sslip*liptranene(itype(i))
11637 gliptranx(3,i)=gliptranx(3,i)
11638 &+ssgradlip*liptranene(itype(i))
11639 gliptranc(3,i-1)= gliptranc(3,i-1)
11640 &+ssgradlip*liptranene(itype(i))
11641 C print *,"doing sccale for lower part"
11642 elseif (positi.gt.bufliptop) then
11644 &((bordliptop-positi)/lipbufthick)
11645 sslip=sscalelip(fracinbuf)
11646 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
11647 eliptran=eliptran+sslip*liptranene(itype(i))
11648 gliptranx(3,i)=gliptranx(3,i)
11649 &+ssgradlip*liptranene(itype(i))
11650 gliptranc(3,i-1)= gliptranc(3,i-1)
11651 &+ssgradlip*liptranene(itype(i))
11652 C print *, "doing sscalefor top part",sslip,fracinbuf
11654 eliptran=eliptran+liptranene(itype(i))
11655 C print *,"I am in true lipid"
11657 endif ! if in lipid or buffor
11659 C eliptran=elpitran+0.0 ! I am in water
11663 C---------------------------------------------------------
11664 C AFM soubroutine for constant force
11665 subroutine AFMforce(Eafmforce)
11666 implicit real*8 (a-h,o-z)
11667 include 'DIMENSIONS'
11668 include 'COMMON.GEO'
11669 include 'COMMON.VAR'
11670 include 'COMMON.LOCAL'
11671 include 'COMMON.CHAIN'
11672 include 'COMMON.DERIV'
11673 include 'COMMON.NAMES'
11674 include 'COMMON.INTERACT'
11675 include 'COMMON.IOUNITS'
11676 include 'COMMON.CALC'
11677 include 'COMMON.CONTROL'
11678 include 'COMMON.SPLITELE'
11679 include 'COMMON.SBRIDGE'
11684 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11685 dist=dist+diffafm(i)**2
11688 Eafmforce=-forceAFMconst*(dist-distafminit)
11690 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
11691 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
11693 C print *,'AFM',Eafmforce
11696 C---------------------------------------------------------
11697 C AFM subroutine with pseudoconstant velocity
11698 subroutine AFMvel(Eafmforce)
11699 implicit real*8 (a-h,o-z)
11700 include 'DIMENSIONS'
11701 include 'COMMON.GEO'
11702 include 'COMMON.VAR'
11703 include 'COMMON.LOCAL'
11704 include 'COMMON.CHAIN'
11705 include 'COMMON.DERIV'
11706 include 'COMMON.NAMES'
11707 include 'COMMON.INTERACT'
11708 include 'COMMON.IOUNITS'
11709 include 'COMMON.CALC'
11710 include 'COMMON.CONTROL'
11711 include 'COMMON.SPLITELE'
11712 include 'COMMON.SBRIDGE'
11714 C Only for check grad COMMENT if not used for checkgrad
11716 C--------------------------------------------------------
11717 C print *,"wchodze"
11721 diffafm(i)=c(i,afmend)-c(i,afmbeg)
11722 dist=dist+diffafm(i)**2
11725 Eafmforce=0.5d0*forceAFMconst
11726 & *(distafminit+totTafm*velAFMconst-dist)**2
11727 C Eafmforce=-forceAFMconst*(dist-distafminit)
11729 gradafm(i,afmend-1)=-forceAFMconst*
11730 &(distafminit+totTafm*velAFMconst-dist)
11732 gradafm(i,afmbeg-1)=forceAFMconst*
11733 &(distafminit+totTafm*velAFMconst-dist)
11736 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist
11739 C-----------------------------------------------------------
11740 C first for shielding is setting of function of side-chains
11741 subroutine set_shield_fac
11742 implicit real*8 (a-h,o-z)
11743 include 'DIMENSIONS'
11744 include 'COMMON.CHAIN'
11745 include 'COMMON.DERIV'
11746 include 'COMMON.IOUNITS'
11747 include 'COMMON.SHIELD'
11748 include 'COMMON.INTERACT'
11749 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11750 double precision div77_81/0.974996043d0/,
11751 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11753 C the vector between center of side_chain and peptide group
11754 double precision pep_side(3),long,side_calf(3),
11755 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11756 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11757 C the line belowe needs to be changed for FGPROC>1
11759 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11761 Cif there two consequtive dummy atoms there is no peptide group between them
11762 C the line below has to be changed for FGPROC>1
11765 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11769 C first lets set vector conecting the ithe side-chain with kth side-chain
11770 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11771 C pep_side(j)=2.0d0
11772 C and vector conecting the side-chain with its proper calfa
11773 side_calf(j)=c(j,k+nres)-c(j,k)
11774 C side_calf(j)=2.0d0
11775 pept_group(j)=c(j,i)-c(j,i+1)
11776 C lets have their lenght
11777 dist_pep_side=pep_side(j)**2+dist_pep_side
11778 dist_side_calf=dist_side_calf+side_calf(j)**2
11779 dist_pept_group=dist_pept_group+pept_group(j)**2
11781 dist_pep_side=dsqrt(dist_pep_side)
11782 dist_pept_group=dsqrt(dist_pept_group)
11783 dist_side_calf=dsqrt(dist_side_calf)
11785 pep_side_norm(j)=pep_side(j)/dist_pep_side
11786 side_calf_norm(j)=dist_side_calf
11788 C now sscale fraction
11789 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
11790 C print *,buff_shield,"buff"
11792 if (sh_frac_dist.le.0.0) cycle
11793 C If we reach here it means that this side chain reaches the shielding sphere
11794 C Lets add him to the list for gradient
11795 ishield_list(i)=ishield_list(i)+1
11796 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
11797 C this list is essential otherwise problem would be O3
11798 shield_list(ishield_list(i),i)=k
11799 C Lets have the sscale value
11800 if (sh_frac_dist.gt.1.0) then
11801 scale_fac_dist=1.0d0
11803 sh_frac_dist_grad(j)=0.0d0
11806 scale_fac_dist=-sh_frac_dist*sh_frac_dist
11807 & *(2.0*sh_frac_dist-3.0d0)
11808 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
11809 & /dist_pep_side/buff_shield*0.5
11810 C remember for the final gradient multiply sh_frac_dist_grad(j)
11811 C for side_chain by factor -2 !
11813 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
11814 C print *,"jestem",scale_fac_dist,fac_help_scale,
11815 C & sh_frac_dist_grad(j)
11818 C if ((i.eq.3).and.(k.eq.2)) then
11819 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
11823 C this is what is now we have the distance scaling now volume...
11824 short=short_r_sidechain(itype(k))
11825 long=long_r_sidechain(itype(k))
11826 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
11829 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
11830 C costhet_fac=0.0d0
11832 costhet_grad(j)=costhet_fac*pep_side(j)
11834 C remember for the final gradient multiply costhet_grad(j)
11835 C for side_chain by factor -2 !
11836 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
11837 C pep_side0pept_group is vector multiplication
11838 pep_side0pept_group=0.0
11840 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
11842 cosalfa=(pep_side0pept_group/
11843 & (dist_pep_side*dist_side_calf))
11844 fac_alfa_sin=1.0-cosalfa**2
11845 fac_alfa_sin=dsqrt(fac_alfa_sin)
11846 rkprim=fac_alfa_sin*(long-short)+short
11848 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
11849 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
11852 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
11853 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11854 &*(long-short)/fac_alfa_sin*cosalfa/
11855 &((dist_pep_side*dist_side_calf))*
11856 &((side_calf(j))-cosalfa*
11857 &((pep_side(j)/dist_pep_side)*dist_side_calf))
11859 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
11860 &*(long-short)/fac_alfa_sin*cosalfa
11861 &/((dist_pep_side*dist_side_calf))*
11863 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
11866 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
11869 C now the gradient...
11870 C grad_shield is gradient of Calfa for peptide groups
11871 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
11873 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
11874 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
11876 grad_shield(j,i)=grad_shield(j,i)
11877 C gradient po skalowaniu
11878 & +(sh_frac_dist_grad(j)
11879 C gradient po costhet
11880 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
11881 &-scale_fac_dist*(cosphi_grad_long(j))
11882 &/(1.0-cosphi) )*div77_81
11884 C grad_shield_side is Cbeta sidechain gradient
11885 grad_shield_side(j,ishield_list(i),i)=
11886 & (sh_frac_dist_grad(j)*-2.0d0
11887 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
11888 & +scale_fac_dist*(cosphi_grad_long(j))
11889 & *2.0d0/(1.0-cosphi))
11890 & *div77_81*VofOverlap
11892 grad_shield_loc(j,ishield_list(i),i)=
11893 & scale_fac_dist*cosphi_grad_loc(j)
11894 & *2.0d0/(1.0-cosphi)
11895 & *div77_81*VofOverlap
11897 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
11899 fac_shield(i)=VolumeTotal*div77_81+div4_81
11900 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
11904 C--------------------------------------------------------------------------
11905 double precision function tschebyshev(m,n,x,y)
11907 include "DIMENSIONS"
11909 double precision x(n),y,yy(0:maxvar),aux
11910 c Tschebyshev polynomial. Note that the first term is omitted
11911 c m=0: the constant term is included
11912 c m=1: the constant term is not included
11916 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
11925 C--------------------------------------------------------------------------
11926 double precision function gradtschebyshev(m,n,x,y)
11928 include "DIMENSIONS"
11930 double precision x(n+1),y,yy(0:maxvar),aux
11931 c Tschebyshev polynomial. Note that the first term is omitted
11932 c m=0: the constant term is included
11933 c m=1: the constant term is not included
11937 yy(i)=2*y*yy(i-1)-yy(i-2)
11941 aux=aux+x(i+1)*yy(i)*(i+1)
11942 C print *, x(i+1),yy(i),i
11944 gradtschebyshev=aux
11947 C------------------------------------------------------------------------
11948 C first for shielding is setting of function of side-chains
11949 subroutine set_shield_fac2
11950 implicit real*8 (a-h,o-z)
11951 include 'DIMENSIONS'
11952 include 'COMMON.CHAIN'
11953 include 'COMMON.DERIV'
11954 include 'COMMON.IOUNITS'
11955 include 'COMMON.SHIELD'
11956 include 'COMMON.INTERACT'
11957 include 'COMMON.LOCAL'
11959 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
11960 double precision div77_81/0.974996043d0/,
11961 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
11963 C the vector between center of side_chain and peptide group
11964 double precision pep_side(3),long,side_calf(3),
11965 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
11966 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
11967 C write(2,*) "ivec",ivec_start,ivec_end
11969 fac_shield(i)=0.0d0
11971 grad_shield(j,i)=0.0d0
11974 C the line belowe needs to be changed for FGPROC>1
11975 do i=ivec_start,ivec_end
11977 C if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11979 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
11980 Cif there two consequtive dummy atoms there is no peptide group between them
11981 C the line below has to be changed for FGPROC>1
11984 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
11988 C first lets set vector conecting the ithe side-chain with kth side-chain
11989 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
11990 C pep_side(j)=2.0d0
11991 C and vector conecting the side-chain with its proper calfa
11992 side_calf(j)=c(j,k+nres)-c(j,k)
11993 C side_calf(j)=2.0d0
11994 pept_group(j)=c(j,i)-c(j,i+1)
11995 C lets have their lenght
11996 dist_pep_side=pep_side(j)**2+dist_pep_side
11997 dist_side_calf=dist_side_calf+side_calf(j)**2
11998 dist_pept_group=dist_pept_group+pept_group(j)**2
12000 dist_pep_side=dsqrt(dist_pep_side)
12001 dist_pept_group=dsqrt(dist_pept_group)
12002 dist_side_calf=dsqrt(dist_side_calf)
12004 pep_side_norm(j)=pep_side(j)/dist_pep_side
12005 side_calf_norm(j)=dist_side_calf
12007 C now sscale fraction
12008 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
12009 C print *,buff_shield,"buff"
12011 if (sh_frac_dist.le.0.0) cycle
12012 C print *,ishield_list(i),i
12013 C If we reach here it means that this side chain reaches the shielding sphere
12014 C Lets add him to the list for gradient
12015 ishield_list(i)=ishield_list(i)+1
12016 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
12017 C this list is essential otherwise problem would be O3
12018 shield_list(ishield_list(i),i)=k
12019 C Lets have the sscale value
12020 if (sh_frac_dist.gt.1.0) then
12021 scale_fac_dist=1.0d0
12023 sh_frac_dist_grad(j)=0.0d0
12026 scale_fac_dist=-sh_frac_dist*sh_frac_dist
12027 & *(2.0d0*sh_frac_dist-3.0d0)
12028 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
12029 & /dist_pep_side/buff_shield*0.5d0
12030 C remember for the final gradient multiply sh_frac_dist_grad(j)
12031 C for side_chain by factor -2 !
12033 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
12034 C sh_frac_dist_grad(j)=0.0d0
12035 C scale_fac_dist=1.0d0
12036 C print *,"jestem",scale_fac_dist,fac_help_scale,
12037 C & sh_frac_dist_grad(j)
12040 C this is what is now we have the distance scaling now volume...
12041 short=short_r_sidechain(itype(k))
12042 long=long_r_sidechain(itype(k))
12043 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
12044 sinthet=short/dist_pep_side*costhet
12048 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
12049 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
12050 C & -short/dist_pep_side**2/costhet)
12051 C costhet_fac=0.0d0
12053 costhet_grad(j)=costhet_fac*pep_side(j)
12055 C remember for the final gradient multiply costhet_grad(j)
12056 C for side_chain by factor -2 !
12057 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
12058 C pep_side0pept_group is vector multiplication
12059 pep_side0pept_group=0.0d0
12061 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
12063 cosalfa=(pep_side0pept_group/
12064 & (dist_pep_side*dist_side_calf))
12065 fac_alfa_sin=1.0d0-cosalfa**2
12066 fac_alfa_sin=dsqrt(fac_alfa_sin)
12067 rkprim=fac_alfa_sin*(long-short)+short
12071 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
12073 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
12074 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
12075 & dist_pep_side**2)
12078 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
12079 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
12080 &*(long-short)/fac_alfa_sin*cosalfa/
12081 &((dist_pep_side*dist_side_calf))*
12082 &((side_calf(j))-cosalfa*
12083 &((pep_side(j)/dist_pep_side)*dist_side_calf))
12084 C cosphi_grad_long(j)=0.0d0
12085 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
12086 &*(long-short)/fac_alfa_sin*cosalfa
12087 &/((dist_pep_side*dist_side_calf))*
12089 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
12090 C cosphi_grad_loc(j)=0.0d0
12092 C print *,sinphi,sinthet
12093 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
12096 C now the gradient...
12098 grad_shield(j,i)=grad_shield(j,i)
12099 C gradient po skalowaniu
12100 & +(sh_frac_dist_grad(j)*VofOverlap
12101 C gradient po costhet
12102 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
12103 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
12104 & sinphi/sinthet*costhet*costhet_grad(j)
12105 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
12107 C grad_shield_side is Cbeta sidechain gradient
12108 grad_shield_side(j,ishield_list(i),i)=
12109 & (sh_frac_dist_grad(j)*-2.0d0
12111 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
12112 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
12113 & sinphi/sinthet*costhet*costhet_grad(j)
12114 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
12117 grad_shield_loc(j,ishield_list(i),i)=
12118 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
12119 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
12120 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
12124 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
12126 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
12127 C write(2,*) "TOTAL VOLUME",i,itype(i),fac_shield(i)
12131 C-----------------------------------------------------------------------
12132 C-----------------------------------------------------------
12133 C This subroutine is to mimic the histone like structure but as well can be
12134 C utilizet to nanostructures (infinit) small modification has to be used to
12135 C make it finite (z gradient at the ends has to be changes as well as the x,y
12136 C gradient has to be modified at the ends
12137 C The energy function is Kihara potential
12138 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
12139 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
12140 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
12141 C simple Kihara potential
12142 subroutine calctube(Etube)
12143 implicit real*8 (a-h,o-z)
12144 include 'DIMENSIONS'
12145 include 'COMMON.GEO'
12146 include 'COMMON.VAR'
12147 include 'COMMON.LOCAL'
12148 include 'COMMON.CHAIN'
12149 include 'COMMON.DERIV'
12150 include 'COMMON.NAMES'
12151 include 'COMMON.INTERACT'
12152 include 'COMMON.IOUNITS'
12153 include 'COMMON.CALC'
12154 include 'COMMON.CONTROL'
12155 include 'COMMON.SPLITELE'
12156 include 'COMMON.SBRIDGE'
12157 double precision tub_r,vectube(3),enetube(maxres*2)
12159 do i=itube_start,itube_end
12161 enetube(i+nres)=0.0d0
12163 C first we calculate the distance from tube center
12164 C first sugare-phosphate group for NARES this would be peptide group
12166 do i=itube_start,itube_end
12167 C lets ommit dummy atoms for now
12168 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
12169 C now calculate distance from center of tube and direction vectors
12173 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
12174 vectube(1)=vectube(1)+boxxsize*j
12175 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
12176 vectube(2)=vectube(2)+boxysize*j
12178 xminact=abs(vectube(1)-tubecenter(1))
12179 yminact=abs(vectube(2)-tubecenter(2))
12180 if (xmin.gt.xminact) then
12184 if (ymin.gt.yminact) then
12191 vectube(1)=vectube(1)-tubecenter(1)
12192 vectube(2)=vectube(2)-tubecenter(2)
12194 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
12195 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
12197 C as the tube is infinity we do not calculate the Z-vector use of Z
12200 C now calculte the distance
12201 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12202 C now normalize vector
12203 vectube(1)=vectube(1)/tub_r
12204 vectube(2)=vectube(2)/tub_r
12205 C calculte rdiffrence between r and r0
12208 rdiff6=rdiff**6.0d0
12209 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12210 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
12211 C write(iout,*) "TU13",i,rdiff6,enetube(i)
12212 C print *,rdiff,rdiff6,pep_aa_tube
12213 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12214 C now we calculate gradient
12215 fac=(-12.0d0*pep_aa_tube/rdiff6-
12216 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
12217 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
12220 C now direction of gg_tube vector
12222 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
12223 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
12226 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
12227 C print *,gg_tube(1,0),"TU"
12230 do i=itube_start,itube_end
12231 C Lets not jump over memory as we use many times iti
12233 C lets ommit dummy atoms for now
12235 C in UNRES uncomment the line below as GLY has no side-chain...
12241 vectube(1)=mod((c(1,i+nres)),boxxsize)
12242 vectube(1)=vectube(1)+boxxsize*j
12243 vectube(2)=mod((c(2,i+nres)),boxysize)
12244 vectube(2)=vectube(2)+boxysize*j
12246 xminact=abs(vectube(1)-tubecenter(1))
12247 yminact=abs(vectube(2)-tubecenter(2))
12248 if (xmin.gt.xminact) then
12252 if (ymin.gt.yminact) then
12259 C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
12261 vectube(1)=vectube(1)-tubecenter(1)
12262 vectube(2)=vectube(2)-tubecenter(2)
12264 C as the tube is infinity we do not calculate the Z-vector use of Z
12267 C now calculte the distance
12268 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12269 C now normalize vector
12270 vectube(1)=vectube(1)/tub_r
12271 vectube(2)=vectube(2)/tub_r
12273 C calculte rdiffrence between r and r0
12276 rdiff6=rdiff**6.0d0
12277 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12278 sc_aa_tube=sc_aa_tube_par(iti)
12279 sc_bb_tube=sc_bb_tube_par(iti)
12280 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
12281 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12282 C now we calculate gradient
12283 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
12284 & 6.0d0*sc_bb_tube/rdiff6/rdiff
12285 C now direction of gg_tube vector
12287 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
12288 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
12291 do i=itube_start,itube_end
12292 Etube=Etube+enetube(i)+enetube(i+nres)
12294 C print *,"ETUBE", etube
12297 C TO DO 1) add to total energy
12298 C 2) add to gradient summation
12299 C 3) add reading parameters (AND of course oppening of PARAM file)
12300 C 4) add reading the center of tube
12302 C 6) add to zerograd
12304 C-----------------------------------------------------------------------
12305 C-----------------------------------------------------------
12306 C This subroutine is to mimic the histone like structure but as well can be
12307 C utilizet to nanostructures (infinit) small modification has to be used to
12308 C make it finite (z gradient at the ends has to be changes as well as the x,y
12309 C gradient has to be modified at the ends
12310 C The energy function is Kihara potential
12311 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
12312 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
12313 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
12314 C simple Kihara potential
12315 subroutine calctube2(Etube)
12316 implicit real*8 (a-h,o-z)
12317 include 'DIMENSIONS'
12318 include 'COMMON.GEO'
12319 include 'COMMON.VAR'
12320 include 'COMMON.LOCAL'
12321 include 'COMMON.CHAIN'
12322 include 'COMMON.DERIV'
12323 include 'COMMON.NAMES'
12324 include 'COMMON.INTERACT'
12325 include 'COMMON.IOUNITS'
12326 include 'COMMON.CALC'
12327 include 'COMMON.CONTROL'
12328 include 'COMMON.SPLITELE'
12329 include 'COMMON.SBRIDGE'
12330 double precision tub_r,vectube(3),enetube(maxres*2)
12332 do i=itube_start,itube_end
12334 enetube(i+nres)=0.0d0
12336 C first we calculate the distance from tube center
12337 C first sugare-phosphate group for NARES this would be peptide group
12339 do i=itube_start,itube_end
12340 C lets ommit dummy atoms for now
12342 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
12343 C now calculate distance from center of tube and direction vectors
12344 C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
12345 C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
12346 C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
12347 C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
12351 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
12352 vectube(1)=vectube(1)+boxxsize*j
12353 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
12354 vectube(2)=vectube(2)+boxysize*j
12356 xminact=abs(vectube(1)-tubecenter(1))
12357 yminact=abs(vectube(2)-tubecenter(2))
12358 if (xmin.gt.xminact) then
12362 if (ymin.gt.yminact) then
12369 vectube(1)=vectube(1)-tubecenter(1)
12370 vectube(2)=vectube(2)-tubecenter(2)
12372 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
12373 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
12375 C as the tube is infinity we do not calculate the Z-vector use of Z
12378 C now calculte the distance
12379 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12380 C now normalize vector
12381 vectube(1)=vectube(1)/tub_r
12382 vectube(2)=vectube(2)/tub_r
12383 C calculte rdiffrence between r and r0
12386 rdiff6=rdiff**6.0d0
12387 C THIS FRAGMENT MAKES TUBE FINITE
12388 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
12389 if (positi.le.0) positi=positi+boxzsize
12390 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
12391 c for each residue check if it is in lipid or lipid water border area
12392 C respos=mod(c(3,i+nres),boxzsize)
12393 print *,positi,bordtubebot,buftubebot,bordtubetop
12394 if ((positi.gt.bordtubebot)
12395 & .and.(positi.lt.bordtubetop)) then
12396 C the energy transfer exist
12397 if (positi.lt.buftubebot) then
12399 & ((positi-bordtubebot)/tubebufthick)
12400 C lipbufthick is thickenes of lipid buffore
12401 sstube=sscalelip(fracinbuf)
12402 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
12403 print *,ssgradtube, sstube,tubetranene(itype(i))
12404 enetube(i)=enetube(i)+sstube*tubetranenepep
12405 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
12406 C &+ssgradtube*tubetranene(itype(i))
12407 C gg_tube(3,i-1)= gg_tube(3,i-1)
12408 C &+ssgradtube*tubetranene(itype(i))
12409 C print *,"doing sccale for lower part"
12410 elseif (positi.gt.buftubetop) then
12412 &((bordtubetop-positi)/tubebufthick)
12413 sstube=sscalelip(fracinbuf)
12414 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
12415 enetube(i)=enetube(i)+sstube*tubetranenepep
12416 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
12417 C &+ssgradtube*tubetranene(itype(i))
12418 C gg_tube(3,i-1)= gg_tube(3,i-1)
12419 C &+ssgradtube*tubetranene(itype(i))
12420 C print *, "doing sscalefor top part",sslip,fracinbuf
12424 enetube(i)=enetube(i)+sstube*tubetranenepep
12425 C print *,"I am in true lipid"
12431 endif ! if in lipid or buffor
12433 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12434 enetube(i)=enetube(i)+sstube*
12435 &(pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
12436 C write(iout,*) "TU13",i,rdiff6,enetube(i)
12437 C print *,rdiff,rdiff6,pep_aa_tube
12438 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12439 C now we calculate gradient
12440 fac=(-12.0d0*pep_aa_tube/rdiff6-
12441 & 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
12442 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
12445 C now direction of gg_tube vector
12447 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
12448 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
12450 gg_tube(3,i)=gg_tube(3,i)
12451 &+ssgradtube*enetube(i)/sstube/2.0d0
12452 gg_tube(3,i-1)= gg_tube(3,i-1)
12453 &+ssgradtube*enetube(i)/sstube/2.0d0
12456 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
12457 C print *,gg_tube(1,0),"TU"
12458 do i=itube_start,itube_end
12459 C Lets not jump over memory as we use many times iti
12461 C lets ommit dummy atoms for now
12463 C in UNRES uncomment the line below as GLY has no side-chain...
12466 vectube(1)=c(1,i+nres)
12467 vectube(1)=mod(vectube(1),boxxsize)
12468 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
12469 vectube(2)=c(2,i+nres)
12470 vectube(2)=mod(vectube(2),boxysize)
12471 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
12473 vectube(1)=vectube(1)-tubecenter(1)
12474 vectube(2)=vectube(2)-tubecenter(2)
12475 C THIS FRAGMENT MAKES TUBE FINITE
12476 positi=(mod(c(3,i+nres),boxzsize))
12477 if (positi.le.0) positi=positi+boxzsize
12478 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
12479 c for each residue check if it is in lipid or lipid water border area
12480 C respos=mod(c(3,i+nres),boxzsize)
12481 print *,positi,bordtubebot,buftubebot,bordtubetop
12482 if ((positi.gt.bordtubebot)
12483 & .and.(positi.lt.bordtubetop)) then
12484 C the energy transfer exist
12485 if (positi.lt.buftubebot) then
12487 & ((positi-bordtubebot)/tubebufthick)
12488 C lipbufthick is thickenes of lipid buffore
12489 sstube=sscalelip(fracinbuf)
12490 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
12491 print *,ssgradtube, sstube,tubetranene(itype(i))
12492 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
12493 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
12494 C &+ssgradtube*tubetranene(itype(i))
12495 C gg_tube(3,i-1)= gg_tube(3,i-1)
12496 C &+ssgradtube*tubetranene(itype(i))
12497 C print *,"doing sccale for lower part"
12498 elseif (positi.gt.buftubetop) then
12500 &((bordtubetop-positi)/tubebufthick)
12501 sstube=sscalelip(fracinbuf)
12502 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
12503 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
12504 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
12505 C &+ssgradtube*tubetranene(itype(i))
12506 C gg_tube(3,i-1)= gg_tube(3,i-1)
12507 C &+ssgradtube*tubetranene(itype(i))
12508 C print *, "doing sscalefor top part",sslip,fracinbuf
12512 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
12513 C print *,"I am in true lipid"
12519 endif ! if in lipid or buffor
12520 CEND OF FINITE FRAGMENT
12521 C as the tube is infinity we do not calculate the Z-vector use of Z
12524 C now calculte the distance
12525 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12526 C now normalize vector
12527 vectube(1)=vectube(1)/tub_r
12528 vectube(2)=vectube(2)/tub_r
12529 C calculte rdiffrence between r and r0
12532 rdiff6=rdiff**6.0d0
12533 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12534 sc_aa_tube=sc_aa_tube_par(iti)
12535 sc_bb_tube=sc_bb_tube_par(iti)
12536 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)
12537 & *sstube+enetube(i+nres)
12538 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12539 C now we calculate gradient
12540 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
12541 & 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
12542 C now direction of gg_tube vector
12544 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
12545 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
12547 gg_tube_SC(3,i)=gg_tube_SC(3,i)
12548 &+ssgradtube*enetube(i+nres)/sstube
12549 gg_tube(3,i-1)= gg_tube(3,i-1)
12550 &+ssgradtube*enetube(i+nres)/sstube
12553 do i=itube_start,itube_end
12554 Etube=Etube+enetube(i)+enetube(i+nres)
12556 C print *,"ETUBE", etube
12559 C TO DO 1) add to total energy
12560 C 2) add to gradient summation
12561 C 3) add reading parameters (AND of course oppening of PARAM file)
12562 C 4) add reading the center of tube
12564 C 6) add to zerograd
12567 C#-------------------------------------------------------------------------------
12568 C This subroutine is to mimic the histone like structure but as well can be
12569 C utilizet to nanostructures (infinit) small modification has to be used to
12570 C make it finite (z gradient at the ends has to be changes as well as the x,y
12571 C gradient has to be modified at the ends
12572 C The energy function is Kihara potential
12573 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
12574 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
12575 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
12576 C simple Kihara potential
12577 subroutine calcnano(Etube)
12578 implicit real*8 (a-h,o-z)
12579 include 'DIMENSIONS'
12580 include 'COMMON.GEO'
12581 include 'COMMON.VAR'
12582 include 'COMMON.LOCAL'
12583 include 'COMMON.CHAIN'
12584 include 'COMMON.DERIV'
12585 include 'COMMON.NAMES'
12586 include 'COMMON.INTERACT'
12587 include 'COMMON.IOUNITS'
12588 include 'COMMON.CALC'
12589 include 'COMMON.CONTROL'
12590 include 'COMMON.SPLITELE'
12591 include 'COMMON.SBRIDGE'
12592 double precision tub_r,vectube(3),enetube(maxres*2),
12593 & enecavtube(maxres*2)
12595 do i=itube_start,itube_end
12597 enetube(i+nres)=0.0d0
12599 C first we calculate the distance from tube center
12600 C first sugare-phosphate group for NARES this would be peptide group
12602 do i=itube_start,itube_end
12603 C lets ommit dummy atoms for now
12604 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
12605 C now calculate distance from center of tube and direction vectors
12611 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
12612 vectube(1)=vectube(1)+boxxsize*j
12613 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
12614 vectube(2)=vectube(2)+boxysize*j
12615 vectube(3)=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
12616 vectube(3)=vectube(3)+boxzsize*j
12619 xminact=abs(vectube(1)-tubecenter(1))
12620 yminact=abs(vectube(2)-tubecenter(2))
12621 zminact=abs(vectube(3)-tubecenter(3))
12623 if (xmin.gt.xminact) then
12627 if (ymin.gt.yminact) then
12631 if (zmin.gt.zminact) then
12640 vectube(1)=vectube(1)-tubecenter(1)
12641 vectube(2)=vectube(2)-tubecenter(2)
12642 vectube(3)=vectube(3)-tubecenter(3)
12644 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
12645 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
12646 C as the tube is infinity we do not calculate the Z-vector use of Z
12649 C now calculte the distance
12650 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12651 C now normalize vector
12652 vectube(1)=vectube(1)/tub_r
12653 vectube(2)=vectube(2)/tub_r
12654 vectube(3)=vectube(3)/tub_r
12655 C calculte rdiffrence between r and r0
12658 rdiff6=rdiff**6.0d0
12659 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12660 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
12661 C write(iout,*) "TU13",i,rdiff6,enetube(i)
12662 C print *,rdiff,rdiff6,pep_aa_tube
12663 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12664 C now we calculate gradient
12665 fac=(-12.0d0*pep_aa_tube/rdiff6-
12666 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
12667 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
12669 if (acavtubpep.eq.0.0d0) then
12674 denominator=(1.0+dcavtubpep*rdiff6*rdiff6)
12676 & (bcavtubpep*rdiff+acavtubpep*sqrt(rdiff)+ccavtubpep)
12679 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/sqrt(rdiff))
12680 & *denominator-(bcavtubpep*rdiff+acavtubpep*sqrt(rdiff)
12681 & +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0)
12682 & /denominator**2.0d0
12687 C print *,"TUT",i,iti,rdiff,rdiff6,acavtubpep,denominator,
12688 C & enecavtube(i),faccav
12690 C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
12691 CX print *,"finene=",enetube(i+nres)+enecavtube(i)
12693 C now direction of gg_tube vector
12695 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
12696 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
12700 do i=itube_start,itube_end
12702 C Lets not jump over memory as we use many times iti
12704 C lets ommit dummy atoms for now
12706 C in UNRES uncomment the line below as GLY has no side-chain...
12713 vectube(1)=mod((c(1,i+nres)),boxxsize)
12714 vectube(1)=vectube(1)+boxxsize*j
12715 vectube(2)=mod((c(2,i+nres)),boxysize)
12716 vectube(2)=vectube(2)+boxysize*j
12717 vectube(3)=mod((c(3,i+nres)),boxzsize)
12718 vectube(3)=vectube(3)+boxzsize*j
12721 xminact=abs(vectube(1)-tubecenter(1))
12722 yminact=abs(vectube(2)-tubecenter(2))
12723 zminact=abs(vectube(3)-tubecenter(3))
12725 if (xmin.gt.xminact) then
12729 if (ymin.gt.yminact) then
12733 if (zmin.gt.zminact) then
12742 C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
12744 vectube(1)=vectube(1)-tubecenter(1)
12745 vectube(2)=vectube(2)-tubecenter(2)
12746 vectube(3)=vectube(3)-tubecenter(3)
12747 C now calculte the distance
12748 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
12749 C now normalize vector
12750 vectube(1)=vectube(1)/tub_r
12751 vectube(2)=vectube(2)/tub_r
12752 vectube(3)=vectube(3)/tub_r
12754 C calculte rdiffrence between r and r0
12757 rdiff6=rdiff**6.0d0
12758 C for vectorization reasons we will sumup at the end to avoid depenence of previous
12759 sc_aa_tube=sc_aa_tube_par(iti)
12760 sc_bb_tube=sc_bb_tube_par(iti)
12761 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
12762 C enetube(i+nres)=0.0d0
12763 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
12764 C now we calculate gradient
12765 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
12766 & 6.0d0*sc_bb_tube/rdiff6/rdiff
12768 C now direction of gg_tube vector
12769 C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
12770 if (acavtub(iti).eq.0.0d0) then
12772 enecavtube(i+nres)=0.0
12775 denominator=(1.0+dcavtub(iti)*rdiff6*rdiff6)
12776 enecavtube(i+nres)=
12777 & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
12779 C enecavtube(i)=0.0
12780 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/sqrt(rdiff))
12781 & *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)
12782 & +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0)
12783 & /denominator**2.0d0
12788 C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
12789 C & enecavtube(i),faccav
12791 C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
12792 C print *,"finene=",enetube(i+nres)+enecavtube(i)
12794 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
12795 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
12798 C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
12799 C do i=itube_start,itube_end
12802 C if (acavtub(iti).eq.0.0) cycle
12806 do i=itube_start,itube_end
12807 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i)
12808 & +enecavtube(i+nres)
12810 C print *,"ETUBE", etube
12813 C TO DO 1) add to total energy
12814 C 2) add to gradient summation
12815 C 3) add reading parameters (AND of course oppening of PARAM file)
12816 C 4) add reading the center of tube
12818 C 6) add to zerograd