2 < C-----------------------------------------------------------------------
3 < double precision function sscale(r)
4 < double precision r,gamm
5 < include "COMMON.SPLITELE"
6 < if(r.lt.r_cut-rlamb) then
8 < else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9 < gamm=(r-(r_cut-rlamb))/rlamb
10 < sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12 > subroutine etotal(energia)
13 > implicit real*8 (a-h,o-z)
14 > include 'DIMENSIONS'
18 > cMS$ATTRIBUTES C :: proc_proc
23 > double precision weights_(n_ene)
25 > include 'COMMON.SETUP'
26 > include 'COMMON.IOUNITS'
27 > double precision energia(0:n_ene)
28 > include 'COMMON.LOCAL'
29 > include 'COMMON.FFIELD'
30 > include 'COMMON.DERIV'
31 > include 'COMMON.INTERACT'
32 > include 'COMMON.SBRIDGE'
33 > include 'COMMON.CHAIN'
34 > include 'COMMON.VAR'
36 > include 'COMMON.CONTROL'
37 > include 'COMMON.TIME1'
38 > if (modecalc.eq.12.or.modecalc.eq.14) then
40 > if (fg_rank.eq.0) call int_from_cart1(.false.)
42 > call int_from_cart1(.false.)
46 > c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
47 > c & " nfgtasks",nfgtasks
48 > if (nfgtasks.gt.1) then
50 > C FG slaves call the following matching MPI_Bcast in ERGASTULUM
51 > if (fg_rank.eq.0) then
52 > call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
53 > c print *,"Processor",myrank," BROADCAST iorder"
54 > C FG master sets up the WEIGHTS_ array which will be broadcast to the
55 > C FG slaves as WEIGHTS array.
70 > weights_(15)=wstrain
75 > C FG Master broadcasts the WEIGHTS_ array
76 > call MPI_Bcast(weights_(1),n_ene,
77 > & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
79 > C FG slaves receive the WEIGHTS array
80 > call MPI_Bcast(weights(1),n_ene,
81 > & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
83 > c print *,"Processor",myrank," BROADCAST weights"
84 > call MPI_Bcast(c(1,1),maxres6,MPI_DOUBLE_PRECISION,
85 > & king,FG_COMM,IERR)
86 > c print *,"Processor",myrank," BROADCAST c"
87 > call MPI_Bcast(dc(1,1),maxres6,MPI_DOUBLE_PRECISION,
88 > & king,FG_COMM,IERR)
89 > c print *,"Processor",myrank," BROADCAST dc"
90 > call MPI_Bcast(dc_norm(1,1),maxres6,MPI_DOUBLE_PRECISION,
91 > & king,FG_COMM,IERR)
92 > c print *,"Processor",myrank," BROADCAST dc_norm"
93 > call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,
94 > & king,FG_COMM,IERR)
95 > c print *,"Processor",myrank," BROADCAST theta"
96 > call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,
97 > & king,FG_COMM,IERR)
98 > c print *,"Processor",myrank," BROADCAST phi"
99 > call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,
100 > & king,FG_COMM,IERR)
101 > c print *,"Processor",myrank," BROADCAST alph"
102 > call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,
103 > & king,FG_COMM,IERR)
104 > c print *,"Processor",myrank," BROADCAST omeg"
105 > call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,
106 > & king,FG_COMM,IERR)
107 > c print *,"Processor",myrank," BROADCAST vbld"
108 > call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,
109 > & king,FG_COMM,IERR)
110 > time_Bcast=time_Bcast+MPI_Wtime()-time00
111 > c print *,"Processor",myrank," BROADCAST vbld_inv"
113 > c print *,'Processor',myrank,' calling etotal ipot=',ipot
114 > c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
117 > C Compute the side-chain and electrostatic interaction energy
119 > goto (101,102,103,104,105,106) ipot
120 > C Lennard-Jones potential.
122 > cd print '(a)','Exit ELJ'
124 > C Lennard-Jones-Kihara potential (shifted).
125 > 102 call eljk(evdw)
127 > C Berne-Pechukas potential (dilated LJ, angular dependence).
130 > C Gay-Berne potential (shifted LJ, angular dependence).
133 > C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
134 > 105 call egbv(evdw)
136 > C Soft-sphere potential
137 > 106 call e_softsphere(evdw)
139 > C Calculate electrostatic (H-bonding) energy of the main chain.
142 > c print *,"Processor",myrank," computed USCSC"
144 > c print *,"Processor",myrank," left VEC_AND_DERIV"
145 > if (ipot.lt.6) then
147 > if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
148 > & wturn3.gt.0d0.or.wturn4.gt.0d0) then
150 > if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
151 > & wturn3.gt.0d0.or.wturn4.gt.0d0) then
153 > call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
164 > c write (iout,*) "Soft-spheer ELEC potential"
165 > call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
170 < C-----------------------------------------------------------------------
171 < subroutine elj_long(evdw)
173 > c print *,"Processor",myrank," computed UELEC"
175 < C This subroutine calculates the interaction energy of nonbonded side chains
176 < C assuming the LJ potential of interaction.
178 > C Calculate excluded-volume interaction energy between peptide groups
181 > if (ipot.lt.6) then
182 > if(wscp.gt.0d0) then
183 > call escp(evdw2,evdw2_14)
189 > c write (iout,*) "Soft-sphere SCP potential"
190 > call escp_soft_sphere(evdw2,evdw2_14)
193 > c Calculate the bond-stretching energy
197 > C Calculate the disulfide-bridge and other energy and the contributions
198 > C from other distance constraints.
199 > cd print *,'Calling EHPB'
201 > cd print *,'EHPB exitted succesfully.'
203 > C Calculate the virtual-bond-angle energy.
205 > if (wang.gt.0d0) then
210 > c print *,"Processor",myrank," computed UB"
212 > C Calculate the SC local energy.
215 > c print *,"Processor",myrank," computed USC"
217 > C Calculate the virtual-bond torsional energy.
219 > cd print *,'nterm=',nterm
220 > if (wtor.gt.0) then
221 > call etor(etors,edihcnstr)
226 > c print *,"Processor",myrank," computed Utor"
228 > C 6/23/01 Calculate double-torsional energy
230 > if (wtor_d.gt.0) then
231 > call etor_d(etors_d)
235 > c print *,"Processor",myrank," computed Utord"
237 > C 21/5/07 Calculate local sicdechain correlation energy
239 > if (wsccor.gt.0.0d0) then
240 > call eback_sc_corr(esccor)
244 > c print *,"Processor",myrank," computed Usccorr"
246 > C 12/1/95 Multi-body terms
250 > if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
251 > & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
252 > call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
253 > c write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
254 > c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
261 > if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
262 > call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
269 > c print *,"Processor",myrank," computed Ucorr"
271 > C If performing constraint dynamics, call the constraint energy
272 > C after the equilibration time
273 > if(usampl.and.totT.gt.eq_time) then
280 > c print *,"Processor",myrank," computed Uconstr"
286 > energia(2)=evdw2-evdw2_14
287 > energia(18)=evdw2_14
296 > energia(3)=ees+evdw1
303 > energia(8)=eello_turn3
304 > energia(9)=eello_turn4
309 > energia(14)=etors_d
311 > energia(19)=edihcnstr
313 > energia(20)=Uconst+Uconst_back
315 > c print *," Processor",myrank," calls SUM_ENERGY"
316 > call sum_energy(energia,.true.)
317 > c print *," Processor",myrank," left SUM_ENERGY"
320 > c-------------------------------------------------------------------------------
321 > subroutine sum_energy(energia,reduce)
323 < parameter (accur=1.0d-10)
324 < include 'COMMON.GEO'
325 < include 'COMMON.VAR'
326 < include 'COMMON.LOCAL'
327 < include 'COMMON.CHAIN'
332 > cMS$ATTRIBUTES C :: proc_proc
338 > include 'COMMON.SETUP'
339 > include 'COMMON.IOUNITS'
340 > double precision energia(0:n_ene),enebuff(0:n_ene+1)
341 > include 'COMMON.FFIELD'
343 < include 'COMMON.TORSION'
345 < include 'COMMON.NAMES'
347 > include 'COMMON.CHAIN'
348 > include 'COMMON.VAR'
349 > include 'COMMON.CONTROL'
350 > include 'COMMON.TIME1'
353 > if (nfgtasks.gt.1 .and. reduce) then
355 > write (iout,*) "energies before REDUCE"
356 > call enerprint(energia)
360 > enebuff(i)=energia(i)
363 > call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
364 > & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
366 > write (iout,*) "energies after REDUCE"
367 > call enerprint(energia)
370 > time_Reduce=time_Reduce+MPI_Wtime()-time00
372 > if (fg_rank.eq.0) then
376 > evdw2=energia(2)+energia(18)
377 > evdw2_14=energia(18)
392 > eello_turn3=energia(8)
393 > eello_turn4=energia(9)
398 > etors_d=energia(14)
400 > edihcnstr=energia(19)
405 > etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
406 > & +wang*ebe+wtor*etors+wscloc*escloc
407 > & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
408 > & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
409 > & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
410 > & +wbond*estr+Uconst+wsccor*esccor
412 > etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
413 > & +wang*ebe+wtor*etors+wscloc*escloc
414 > & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
415 > & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
416 > & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
417 > & +wbond*estr+Uconst+wsccor*esccor
423 > if (isnan(etot).ne.0) energia(0)=1.0d+99
425 > if (isnan(etot)) energia(0)=1.0d+99
430 > idumm=proc_proc(etot,i)
432 > call proc_proc(etot,i)
434 > if(i.eq.1)energia(0)=1.0d+99
441 > c-------------------------------------------------------------------------------
442 > subroutine sum_gradient
443 > implicit real*8 (a-h,o-z)
444 > include 'DIMENSIONS'
448 > cMS$ATTRIBUTES C :: proc_proc
453 > double precision gradbufc(3,maxres),gradbufx(3,maxres),
454 > & glocbuf(4*maxres)
456 > include 'COMMON.SETUP'
458 < include 'COMMON.CONTACTS'
460 < c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
462 < do i=iatsc_s,iatsc_e
469 < C Calculate SC interaction energy.
471 > include 'COMMON.FFIELD'
472 > include 'COMMON.DERIV'
473 > include 'COMMON.INTERACT'
474 > include 'COMMON.SBRIDGE'
475 > include 'COMMON.CHAIN'
476 > include 'COMMON.VAR'
477 > include 'COMMON.CONTROL'
478 > include 'COMMON.TIME1'
479 > include 'COMMON.MAXGRAD'
481 < do iint=1,nint_gr(i)
482 < cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
483 < cd & 'iend=',iend(i,iint)
484 < do j=istart(i,iint),iend(i,iint)
489 < rij=xj*xj+yj*yj+zj*zj
490 < sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
491 < if (sss.lt.1.0d0) then
494 < e1=fac*fac*aa(itypi,itypj)
495 < e2=fac*bb(itypi,itypj)
497 < evdw=evdw+(1.0d0-sss)*evdwij
499 < C Calculate the components of the gradient in DC and X
501 > C Sum up the components of the Cartesian gradient.
503 < fac=-rrij*(e1+evdwij)*(1.0d0-sss)
508 < gvdwx(k,i)=gvdwx(k,i)-gg(k)
509 < gvdwx(k,j)=gvdwx(k,j)+gg(k)
513 < gvdwc(l,k)=gvdwc(l,k)+gg(l)
523 < gvdwc(j,i)=expon*gvdwc(j,i)
524 < gvdwx(j,i)=expon*gvdwx(j,i)
526 > gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
527 > & welec*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
528 > & wbond*gradb(j,i)+
529 > & wstrain*ghpbc(j,i)+
530 > & wcorr*gradcorr(j,i)+
531 > & wel_loc*gel_loc(j,i)+
532 > & wturn3*gcorr3_turn(j,i)+
533 > & wturn4*gcorr4_turn(j,i)+
534 > & wcorr5*gradcorr5(j,i)+
535 > & wcorr6*gradcorr6(j,i)+
536 > & wturn6*gcorr6_turn(j,i)+
537 > & wsccor*gsccorc(j,i)
538 > & +wscloc*gscloc(j,i)
539 > gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
540 > & wbond*gradbx(j,i)+
541 > & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
542 > & wsccor*gsccorx(j,i)
543 > & +wscloc*gsclocx(j,i)
549 > gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
550 > & welec*gelc(j,i)+wstrain*ghpbc(j,i)+
551 > & wbond*gradb(j,i)+
552 > & wcorr*gradcorr(j,i)+
553 > & wel_loc*gel_loc(j,i)+
554 > & wturn3*gcorr3_turn(j,i)+
555 > & wturn4*gcorr4_turn(j,i)+
556 > & wcorr5*gradcorr5(j,i)+
557 > & wcorr6*gradcorr6(j,i)+
558 > & wturn6*gcorr6_turn(j,i)+
559 > & wsccor*gsccorc(j,i)
560 > & +wscloc*gscloc(j,i)
561 > gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
562 > & wbond*gradbx(j,i)+
563 > & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
564 > & wsccor*gsccorx(j,i)
565 > & +wscloc*gsclocx(j,i)
570 > gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
571 > & +wcorr5*g_corr5_loc(i)
572 > & +wcorr6*g_corr6_loc(i)
573 > & +wturn4*gel_loc_turn4(i)
574 > & +wturn3*gel_loc_turn3(i)
575 > & +wturn6*gel_loc_turn6(i)
576 > & +wel_loc*gel_loc_loc(i)
577 > & +wsccor*gsccor_loc(i)
579 < C******************************************************************************
583 < C To save time, the factor of EXPON has been extracted from ALL components
584 < C of GVDWC and GRADX. Remember to multiply them by this factor before further
587 < C******************************************************************************
590 > if (nfgtasks.gt.1) then
593 > gradbufc(j,i)=gradc(j,i,icg)
594 > gradbufx(j,i)=gradx(j,i,icg)
598 > glocbuf(i)=gloc(i,icg)
600 > C FG slaves call the following matching MPI_Bcast in ERGASTULUM
601 > if (fg_rank.eq.0) call MPI_Bcast(1,1,MPI_INTEGER,
602 > & king,FG_COMM,IERROR)
604 > call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
605 > & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
606 > call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
607 > & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
608 > call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
609 > & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
610 > time_reduce=time_reduce+MPI_Wtime()-time00
613 > if (gnorm_check) then
615 > c Compute the maximum elements of the gradient
618 > gvdwc_scp_max=0.0d0
625 > gcorr3_turn_max=0.0d0
626 > gcorr4_turn_max=0.0d0
627 > gradcorr5_max=0.0d0
628 > gradcorr6_max=0.0d0
629 > gcorr6_turn_max=0.0d0
633 > gradx_scp_max=0.0d0
639 > gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
640 > if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
641 > gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
642 > if (gvdwc_scp_norm.gt.gvdwc_scp_max)
643 > & gvdwc_scp_max=gvdwc_scp_norm
644 > gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
645 > if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
646 > gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
647 > if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
648 > gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
649 > if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
650 > ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
651 > if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
652 > gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
653 > if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
654 > gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
655 > if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
656 > gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
657 > & gcorr3_turn(1,i)))
658 > if (gcorr3_turn_norm.gt.gcorr3_turn_max)
659 > & gcorr3_turn_max=gcorr3_turn_norm
660 > gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
661 > & gcorr4_turn(1,i)))
662 > if (gcorr4_turn_norm.gt.gcorr4_turn_max)
663 > & gcorr4_turn_max=gcorr4_turn_norm
664 > gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
665 > if (gradcorr5_norm.gt.gradcorr5_max)
666 > & gradcorr5_max=gradcorr5_norm
667 > gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
668 > if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
669 > gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
670 > & gcorr6_turn(1,i)))
671 > if (gcorr6_turn_norm.gt.gcorr6_turn_max)
672 > & gcorr6_turn_max=gcorr6_turn_norm
673 > gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
674 > if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
675 > gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
676 > if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
677 > gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
678 > if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
679 > gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
680 > if (gradx_scp_norm.gt.gradx_scp_max)
681 > & gradx_scp_max=gradx_scp_norm
682 > ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
683 > if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
684 > gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
685 > if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
686 > gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
687 > if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
688 > gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
689 > if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
693 > open(istat,file=statname,position="append")
695 > open(istat,file=statname,access="append")
697 > write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
698 > & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
699 > & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
700 > & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
701 > & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
702 > & gsccorx_max,gsclocx_max
704 > if (gvdwc_max.gt.1.0d4) then
705 > write (iout,*) "gvdwc gvdwx gradb gradbx"
707 > write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
708 > & gradb(j,i),gradbx(j,i),j=1,3)
710 > call pdbout(0.0d0,'cipiszcze',iout)
716 > write (iout,*) "gradc gradx gloc"
718 > write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
719 > & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
724 > c-------------------------------------------------------------------------------
725 > subroutine rescale_weights(t_bath)
726 > implicit real*8 (a-h,o-z)
727 > include 'DIMENSIONS'
728 > include 'COMMON.IOUNITS'
729 > include 'COMMON.FFIELD'
730 > include 'COMMON.SBRIDGE'
731 > double precision kfac /2.4d0/
732 > double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
733 > c facT=temp0/t_bath
734 > c facT=2*temp0/(t_bath+temp0)
735 > if (rescale_mode.eq.0) then
741 > else if (rescale_mode.eq.1) then
742 > facT=kfac/(kfac-1.0d0+t_bath/temp0)
743 > facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
744 > facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
745 > facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
746 > facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
747 > else if (rescale_mode.eq.2) then
753 > facT=licznik/dlog(dexp(x)+dexp(-x))
754 > facT2=licznik/dlog(dexp(x2)+dexp(-x2))
755 > facT3=licznik/dlog(dexp(x3)+dexp(-x3))
756 > facT4=licznik/dlog(dexp(x4)+dexp(-x4))
757 > facT5=licznik/dlog(dexp(x5)+dexp(-x5))
759 > write (iout,*) "Wrong RESCALE_MODE",rescale_mode
760 > write (*,*) "Wrong RESCALE_MODE",rescale_mode
762 > call MPI_Finalize(MPI_COMM_WORLD,IERROR)
766 > welec=weights(3)*fact
767 > wcorr=weights(4)*fact3
768 > wcorr5=weights(5)*fact4
769 > wcorr6=weights(6)*fact5
770 > wel_loc=weights(7)*fact2
771 > wturn3=weights(8)*fact2
772 > wturn4=weights(9)*fact3
773 > wturn6=weights(10)*fact5
774 > wtor=weights(13)*fact
775 > wtor_d=weights(14)*fact2
776 > wsccor=weights(21)*fact
780 > C------------------------------------------------------------------------
781 > subroutine enerprint(energia)
782 > implicit real*8 (a-h,o-z)
783 > include 'DIMENSIONS'
784 > include 'COMMON.IOUNITS'
785 > include 'COMMON.FFIELD'
786 > include 'COMMON.SBRIDGE'
787 > include 'COMMON.MD'
788 > double precision energia(0:n_ene)
793 > evdw2=energia(2)+energia(18)
805 > eello_turn3=energia(8)
806 > eello_turn4=energia(9)
807 > eello_turn6=energia(10)
811 > etors_d=energia(14)
813 > edihcnstr=energia(19)
818 > write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
819 > & estr,wbond,ebe,wang,
820 > & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
822 > & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
823 > & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
824 > & edihcnstr,ebr*nss,
826 > 10 format (/'Virtual-chain energies:'//
827 > & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
828 > & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
829 > & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
830 > & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
831 > & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
832 > & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
833 > & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
834 > & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
835 > & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
836 > & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
837 > & ' (SS bridges & dist. cnstr.)'/
838 > & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
839 > & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
840 > & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
841 > & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
842 > & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
843 > & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
844 > & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
845 > & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
846 > & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
847 > & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
848 > & 'UCONST= ',1pE16.6,' (Constraint energy)'/
849 > & 'ETOT= ',1pE16.6,' (total)')
851 > write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
852 > & estr,wbond,ebe,wang,
853 > & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
855 > & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
856 > & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
857 > & ebr*nss,Uconst,etot
858 > 10 format (/'Virtual-chain energies:'//
859 > & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
860 > & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
861 > & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
862 > & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
863 > & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
864 > & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
865 > & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
866 > & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
867 > & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
868 > & ' (SS bridges & dist. cnstr.)'/
869 > & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
870 > & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
871 > & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
872 > & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
873 > & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
874 > & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
875 > & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
876 > & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
877 > & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
878 > & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
879 > & 'UCONST=',1pE16.6,' (Constraint energy)'/
880 > & 'ETOT= ',1pE16.6,' (total)')
883 < subroutine elj_short(evdw)
885 > subroutine elj(evdw)
890 > C Change 12/1/95 to calculate four-body interactions
892 < sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
893 < if (sss.gt.0.0d0) then
896 < e1=fac*fac*aa(itypi,itypj)
897 < e2=fac*bb(itypi,itypj)
899 < evdw=evdw+sss*evdwij
902 > c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
903 > eps0ij=eps(itypi,itypj)
905 > e1=fac*fac*aa(itypi,itypj)
906 > e2=fac*bb(itypi,itypj)
908 > cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
909 > cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
910 > cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
911 > cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
912 > cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
913 > cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
916 < fac=-rrij*(e1+evdwij)*sss
921 < gvdwx(k,i)=gvdwx(k,i)-gg(k)
922 < gvdwx(k,j)=gvdwx(k,j)+gg(k)
926 < gvdwc(l,k)=gvdwc(l,k)+gg(l)
929 > fac=-rrij*(e1+evdwij)
934 > gvdwx(k,i)=gvdwx(k,i)-gg(k)
935 > gvdwx(k,j)=gvdwx(k,j)+gg(k)
939 > gvdwc(l,k)=gvdwc(l,k)+gg(l)
943 > C 12/1/95, revised on 5/20/97
945 > C Calculate the contact function. The ith column of the array JCONT will
946 > C contain the numbers of atoms that make contacts with the atom I (of numbers
947 > C greater than I). The arrays FACONT and GACONT will contain the values of
948 > C the contact function and its derivative.
950 > C Uncomment next line, if the correlation interactions include EVDW explicitly.
951 > c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
952 > C Uncomment next line, if the correlation interactions are contact function only
953 > if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
955 > sigij=sigma(itypi,itypj)
956 > r0ij=rs0(itypi,itypj)
958 > C Check whether the SC's are not too far to make a contact.
961 > call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
962 > C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
964 > if (fcont.gt.0.0D0) then
965 > C If the SC-SC distance if close to sigma, apply spline.
966 > cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
967 > cAdam & fcont1,fprimcont1)
968 > cAdam fcont1=1.0d0-fcont1
969 > cAdam if (fcont1.gt.0.0d0) then
970 > cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
971 > cAdam fcont=fcont*fcont1
973 > C Uncomment following 4 lines to have the geometric average of the epsilon0's
974 > cga eps0ij=1.0d0/dsqrt(eps0ij)
976 > cga gg(k)=gg(k)*eps0ij
978 > cga eps0ij=-evdwij*eps0ij
979 > C Uncomment for AL's type of SC correlation interactions.
980 > cadam eps0ij=-evdwij
981 > num_conti=num_conti+1
982 > jcont(num_conti,i)=j
983 > facont(num_conti,i)=fcont*eps0ij
984 > fprimcont=eps0ij*fprimcont/rij
986 > cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
987 > cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
988 > cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
989 > C Uncomment following 3 lines for Skolnick's type of SC correlation.
990 > gacont(1,num_conti,i)=-fprimcont*xj
991 > gacont(2,num_conti,i)=-fprimcont*yj
992 > gacont(3,num_conti,i)=-fprimcont*zj
993 > cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
994 > cd write (iout,'(2i3,3f10.5)')
995 > cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
999 > num_cont(i)=num_conti
1001 < subroutine eljk_long(evdw)
1003 > subroutine eljk(evdw)
1005 < sss=sscale(rij/sigma(itypi,itypj))
1007 < if (sss.lt.1.0d0) then
1009 < r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1010 < fac=r_shift_inv**expon
1011 < e1=fac*fac*aa(itypi,itypj)
1012 < e2=fac*bb(itypi,itypj)
1013 < evdwij=e_augm+e1+e2
1014 < cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1015 < cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1016 < cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1017 < cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1018 < cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1019 < cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1020 < cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1021 < evdw=evdw+evdwij*(1.0d0-sss)
1023 > r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1024 > fac=r_shift_inv**expon
1025 > e1=fac*fac*aa(itypi,itypj)
1026 > e2=fac*bb(itypi,itypj)
1027 > evdwij=e_augm+e1+e2
1028 > cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1029 > cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1030 > cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1031 > cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1032 > cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1033 > cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1034 > cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1037 < fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1038 < fac=fac*(1.0d0-sss)
1043 < gvdwx(k,i)=gvdwx(k,i)-gg(k)
1044 < gvdwx(k,j)=gvdwx(k,j)+gg(k)
1048 < gvdwc(l,k)=gvdwc(l,k)+gg(l)
1051 > fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1056 > gvdwx(k,i)=gvdwx(k,i)-gg(k)
1057 > gvdwx(k,j)=gvdwx(k,j)+gg(k)
1061 > gvdwc(l,k)=gvdwc(l,k)+gg(l)
1069 < subroutine eljk_short(evdw)
1071 > subroutine ebp(evdw)
1073 < C assuming the LJK potential of interaction.
1075 > C assuming the Berne-Pechukas potential of interaction.
1077 > include 'COMMON.NAMES'
1079 < include 'COMMON.NAMES'
1082 < c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1084 < do i=iatsc_s,iatsc_e
1091 < C Calculate SC interaction energy.
1093 < do iint=1,nint_gr(i)
1094 < do j=istart(i,iint),iend(i,iint)
1099 < rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1100 < fac_augm=rrij**expon
1101 < e_augm=augm(itypi,itypj)*fac_augm
1102 < r_inv_ij=dsqrt(rrij)
1103 < rij=1.0D0/r_inv_ij
1104 < sss=sscale(rij/sigma(itypi,itypj))
1106 < if (sss.gt.0.0d0) then
1108 < r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1109 < fac=r_shift_inv**expon
1110 < e1=fac*fac*aa(itypi,itypj)
1111 < e2=fac*bb(itypi,itypj)
1112 < evdwij=e_augm+e1+e2
1113 < cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1114 < cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1115 < cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1116 < cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1117 < cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1118 < cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1119 < cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1120 < evdw=evdw+evdwij*sss
1122 < C Calculate the components of the gradient in DC and X
1124 < fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1130 < gvdwx(k,i)=gvdwx(k,i)-gg(k)
1131 < gvdwx(k,j)=gvdwx(k,j)+gg(k)
1135 < gvdwc(l,k)=gvdwc(l,k)+gg(l)
1146 < gvdwc(j,i)=expon*gvdwc(j,i)
1147 < gvdwx(j,i)=expon*gvdwx(j,i)
1152 < C-----------------------------------------------------------------------------
1153 < subroutine ebp_long(evdw)
1155 < C This subroutine calculates the interaction energy of nonbonded side chains
1156 < C assuming the Berne-Pechukas potential of interaction.
1158 < implicit real*8 (a-h,o-z)
1159 < include 'DIMENSIONS'
1160 < include 'COMMON.GEO'
1161 < include 'COMMON.VAR'
1162 < include 'COMMON.LOCAL'
1163 < include 'COMMON.CHAIN'
1164 < include 'COMMON.DERIV'
1165 < include 'COMMON.NAMES'
1166 < include 'COMMON.INTERACT'
1167 < include 'COMMON.IOUNITS'
1168 < include 'COMMON.CALC'
1169 < common /srutu/ icall
1170 < c double precision rrsave(maxdim)
1173 > include 'COMMON.CALC'
1174 > common /srutu/ icall
1175 > c double precision rrsave(maxdim)
1178 < sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
1180 < if (sss.lt.1.0d0) then
1187 < fac=(rrij*sigsq)**expon2
1188 < e1=fac*fac*aa(itypi,itypj)
1189 < e2=fac*bb(itypi,itypj)
1190 < evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1191 < eps2der=evdwij*eps3rt
1192 < eps3der=evdwij*eps2rt
1193 < evdwij=evdwij*eps2rt*eps3rt
1194 < evdw=evdw+evdwij*(1.0d0-sss)
1196 < sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1197 < epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1199 > fac=(rrij*sigsq)**expon2
1200 > e1=fac*fac*aa(itypi,itypj)
1201 > e2=fac*bb(itypi,itypj)
1202 > evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1203 > eps2der=evdwij*eps3rt
1204 > eps3der=evdwij*eps2rt
1205 > evdwij=evdwij*eps2rt*eps3rt
1208 > sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1209 > epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1212 < C Calculate gradient components.
1213 < e1=e1*eps1*eps2rt**2*eps3rt**2
1214 < fac=-expon*(e1+evdwij)
1217 < C Calculate radial part of the gradient
1221 < C Calculate the angular part of the gradient and sum add the contributions
1222 < C to the appropriate components of the Cartesian gradient.
1223 < call sc_grad_scale(1.0d0-sss)
1233 < C-----------------------------------------------------------------------------
1234 < subroutine ebp_short(evdw)
1236 < C This subroutine calculates the interaction energy of nonbonded side chains
1237 < C assuming the Berne-Pechukas potential of interaction.
1239 < implicit real*8 (a-h,o-z)
1240 < include 'DIMENSIONS'
1241 < include 'COMMON.GEO'
1242 < include 'COMMON.VAR'
1243 < include 'COMMON.LOCAL'
1244 < include 'COMMON.CHAIN'
1245 < include 'COMMON.DERIV'
1246 < include 'COMMON.NAMES'
1247 < include 'COMMON.INTERACT'
1248 < include 'COMMON.IOUNITS'
1249 < include 'COMMON.CALC'
1250 < common /srutu/ icall
1251 < c double precision rrsave(maxdim)
1254 < c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1256 < c if (icall.eq.0) then
1262 < do i=iatsc_s,iatsc_e
1268 < dxi=dc_norm(1,nres+i)
1269 < dyi=dc_norm(2,nres+i)
1270 < dzi=dc_norm(3,nres+i)
1271 < c dsci_inv=dsc_inv(itypi)
1272 < dsci_inv=vbld_inv(i+nres)
1274 < C Calculate SC interaction energy.
1276 < do iint=1,nint_gr(i)
1277 < do j=istart(i,iint),iend(i,iint)
1280 < c dscj_inv=dsc_inv(itypj)
1281 < dscj_inv=vbld_inv(j+nres)
1282 < chi1=chi(itypi,itypj)
1283 < chi2=chi(itypj,itypi)
1287 < chip12=chip1*chip2
1290 < alf12=0.5D0*(alf1+alf2)
1291 < C For diagnostics only!!!
1304 < dxj=dc_norm(1,nres+j)
1305 < dyj=dc_norm(2,nres+j)
1306 < dzj=dc_norm(3,nres+j)
1307 < rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1308 < cd if (icall.eq.0) then
1309 < cd rrsave(ind)=rrij
1311 < cd rrij=rrsave(ind)
1314 < sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
1316 < if (sss.gt.0.0d0) then
1318 < C Calculate the angle-dependent terms of energy & contributions to derivatives.
1320 < C Calculate whole angle-dependent part of epsilon and contributions
1321 < C to its derivatives
1322 < fac=(rrij*sigsq)**expon2
1323 < e1=fac*fac*aa(itypi,itypj)
1324 < e2=fac*bb(itypi,itypj)
1325 < evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1326 < eps2der=evdwij*eps3rt
1327 < eps3der=evdwij*eps2rt
1328 < evdwij=evdwij*eps2rt*eps3rt
1329 < evdw=evdw+evdwij*sss
1331 < sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1332 < epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1333 < cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1334 < cd & restyp(itypi),i,restyp(itypj),j,
1335 < cd & epsi,sigm,chi1,chi2,chip1,chip2,
1336 < cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1337 < cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1341 < e1=e1*eps1*eps2rt**2*eps3rt**2
1342 < fac=-expon*(e1+evdwij)
1346 > e1=e1*eps1*eps2rt**2*eps3rt**2
1347 > fac=-expon*(e1+evdwij)
1359 < call sc_grad_scale(sss)
1366 < subroutine egb_long(evdw)
1368 > subroutine egb(evdw)
1370 < sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
1371 < c write(iout,*) "long",i,itypi,j,itypj," rij",1.0d0/rij,
1372 < c & " sigmaii",sigmaii(itypi,itypj)," sss",sss
1374 < if (sss.lt.1.0d0) then
1379 < sig=sig0ij*dsqrt(sigsq)
1380 < rij_shift=1.0D0/rij-sig+sig0ij
1384 > sig=sig0ij*dsqrt(sigsq)
1385 > rij_shift=1.0D0/rij-sig+sig0ij
1387 < c rij_shift=1.2*sig0ij
1389 > c rij_shift=1.2*sig0ij
1391 < if (rij_shift.le.0.0D0) then
1393 < cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1394 < cd & restyp(itypi),i,restyp(itypj),j,
1395 < cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1400 > if (rij_shift.le.0.0D0) then
1402 > cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1403 > cd & restyp(itypi),i,restyp(itypj),j,
1404 > cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1409 < rij_shift=1.0D0/rij_shift
1410 < fac=rij_shift**expon
1411 < e1=fac*fac*aa(itypi,itypj)
1412 < e2=fac*bb(itypi,itypj)
1413 < evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1414 < eps2der=evdwij*eps3rt
1415 < eps3der=evdwij*eps2rt
1416 < c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1418 > rij_shift=1.0D0/rij_shift
1419 > fac=rij_shift**expon
1420 > e1=fac*fac*aa(itypi,itypj)
1421 > e2=fac*bb(itypi,itypj)
1422 > evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1423 > eps2der=evdwij*eps3rt
1424 > eps3der=evdwij*eps2rt
1425 > c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1427 < evdwij=evdwij*eps2rt*eps3rt
1428 < evdw=evdw+evdwij*(1.0d0-sss)
1429 < c write (iout,*) "evdwij",evdwij," evdw",evdw
1431 < sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1432 < epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1433 < write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1434 < & restyp(itypi),i,restyp(itypj),j,
1435 < & epsi,sigm,chi1,chi2,chip1,chip2,
1436 < & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1437 < & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1441 > evdwij=evdwij*eps2rt*eps3rt
1444 > sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1445 > epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1446 > write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1447 > & restyp(itypi),i,restyp(itypj),j,
1448 > & epsi,sigm,chi1,chi2,chip1,chip2,
1449 > & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1450 > & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1454 < if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1456 > if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1458 < e1=e1*eps1*eps2rt**2*eps3rt**2
1459 < fac=-expon*(e1+evdwij)*rij_shift
1464 > e1=e1*eps1*eps2rt**2*eps3rt**2
1465 > fac=-expon*(e1+evdwij)*rij_shift
1478 < call sc_grad_scale(1.0d0-sss)
1485 < subroutine egb_short(evdw)
1487 > subroutine egbv(evdw)
1489 < C assuming the Gay-Berne potential of interaction.
1491 > C assuming the Gay-Berne-Vorobjev potential of interaction.
1493 < include 'COMMON.CONTROL'
1495 > common /srutu/ icall
1497 < ccccc energy_dec=.false.
1499 < c if (icall.eq.0) lprn=.false.
1501 > c if (icall.eq.0) lprn=.true.
1503 < c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1504 < c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1506 < c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1507 < c & 1.0d0/vbld(j+nres)
1508 < c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1510 > r0ij=r0(itypi,itypj)
1512 < c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1513 < c write (iout,*) "j",j," dc_norm",
1514 < c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1516 < sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
1517 < c write(iout,*) "short",i,itypi,j,itypj," rij",1.0d0/rij,
1518 < c & " sigmaii",sigmaii(itypi,itypj)," sss",sss
1519 < if (sss.gt.0.0d0) then
1524 < sig=sig0ij*dsqrt(sigsq)
1525 < rij_shift=1.0D0/rij-sig+sig0ij
1526 < c for diagnostics; uncomment
1527 < c rij_shift=1.2*sig0ij
1531 > sig=sig0ij*dsqrt(sigsq)
1532 > rij_shift=1.0D0/rij-sig+r0ij
1534 < if (rij_shift.le.0.0D0) then
1536 < cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1537 < cd & restyp(itypi),i,restyp(itypj),j,
1538 < cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1543 > if (rij_shift.le.0.0D0) then
1549 < rij_shift=1.0D0/rij_shift
1550 < fac=rij_shift**expon
1551 < e1=fac*fac*aa(itypi,itypj)
1552 < e2=fac*bb(itypi,itypj)
1553 < evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1554 < eps2der=evdwij*eps3rt
1555 < eps3der=evdwij*eps2rt
1556 < c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1557 < c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1558 < evdwij=evdwij*eps2rt*eps3rt
1559 < evdw=evdw+evdwij*sss
1560 < c write (iout,*) "evdwij",evdwij," evdw",evdw
1562 < sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1563 < epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1564 < write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1565 < & restyp(itypi),i,restyp(itypj),j,
1566 < & epsi,sigm,chi1,chi2,chip1,chip2,
1567 < & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1568 < & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1572 < if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1573 < & 'evdw',i,j,evdwij
1576 > rij_shift=1.0D0/rij_shift
1577 > fac=rij_shift**expon
1578 > e1=fac*fac*aa(itypi,itypj)
1579 > e2=fac*bb(itypi,itypj)
1580 > evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1581 > eps2der=evdwij*eps3rt
1582 > eps3der=evdwij*eps2rt
1583 > fac_augm=rrij**expon
1584 > e_augm=augm(itypi,itypj)*fac_augm
1585 > evdwij=evdwij*eps2rt*eps3rt
1586 > evdw=evdw+evdwij+e_augm
1588 > sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1589 > epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1590 > write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1591 > & restyp(itypi),i,restyp(itypj),j,
1592 > & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1593 > & chi1,chi2,chip1,chip2,
1594 > & eps1,eps2rt**2,eps3rt**2,
1595 > & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1599 < e1=e1*eps1*eps2rt**2*eps3rt**2
1600 < fac=-expon*(e1+evdwij)*rij_shift
1605 > e1=e1*eps1*eps2rt**2*eps3rt**2
1606 > fac=-expon*(e1+evdwij)*rij_shift
1608 > fac=rij*fac-2*expon*rrij*e_augm
1618 < call sc_grad_scale(sss)
1625 < cccc energy_dec=.false.
1628 < subroutine egbv_long(evdw)
1630 < C This subroutine calculates the interaction energy of nonbonded side chains
1631 < C assuming the Gay-Berne-Vorobjev potential of interaction.
1633 < implicit real*8 (a-h,o-z)
1634 < include 'DIMENSIONS'
1635 < include 'COMMON.GEO'
1636 < include 'COMMON.VAR'
1637 < include 'COMMON.LOCAL'
1638 < include 'COMMON.CHAIN'
1639 < include 'COMMON.DERIV'
1640 < include 'COMMON.NAMES'
1641 < include 'COMMON.INTERACT'
1642 < include 'COMMON.IOUNITS'
1643 < include 'COMMON.CALC'
1644 < common /srutu/ icall
1647 < c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1650 < c if (icall.eq.0) lprn=.true.
1652 < do i=iatsc_s,iatsc_e
1658 < dxi=dc_norm(1,nres+i)
1659 < dyi=dc_norm(2,nres+i)
1660 < dzi=dc_norm(3,nres+i)
1661 < c dsci_inv=dsc_inv(itypi)
1662 < dsci_inv=vbld_inv(i+nres)
1664 < C Calculate SC interaction energy.
1666 < do iint=1,nint_gr(i)
1667 < do j=istart(i,iint),iend(i,iint)
1670 < c dscj_inv=dsc_inv(itypj)
1671 < dscj_inv=vbld_inv(j+nres)
1672 < sig0ij=sigma(itypi,itypj)
1673 < r0ij=r0(itypi,itypj)
1674 < chi1=chi(itypi,itypj)
1675 < chi2=chi(itypj,itypi)
1679 < chip12=chip1*chip2
1682 < alf12=0.5D0*(alf1+alf2)
1683 < C For diagnostics only!!!
1696 < dxj=dc_norm(1,nres+j)
1697 < dyj=dc_norm(2,nres+j)
1698 < dzj=dc_norm(3,nres+j)
1699 < rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1702 < sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
1704 < if (sss.lt.1.0d0) then
1706 < C Calculate angle-dependent terms of energy and contributions to their
1710 < sig=sig0ij*dsqrt(sigsq)
1711 < rij_shift=1.0D0/rij-sig+r0ij
1712 < C I hate to put IF's in the loops, but here don't have another choice!!!!
1713 < if (rij_shift.le.0.0D0) then
1718 < c---------------------------------------------------------------
1719 < rij_shift=1.0D0/rij_shift
1720 < fac=rij_shift**expon
1721 < e1=fac*fac*aa(itypi,itypj)
1722 < e2=fac*bb(itypi,itypj)
1723 < evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1724 < eps2der=evdwij*eps3rt
1725 < eps3der=evdwij*eps2rt
1726 < fac_augm=rrij**expon
1727 < e_augm=augm(itypi,itypj)*fac_augm
1728 < evdwij=evdwij*eps2rt*eps3rt
1729 < evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
1731 < sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1732 < epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1733 < write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1734 < & restyp(itypi),i,restyp(itypj),j,
1735 < & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1736 < & chi1,chi2,chip1,chip2,
1737 < & eps1,eps2rt**2,eps3rt**2,
1738 < & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1741 < C Calculate gradient components.
1742 < e1=e1*eps1*eps2rt**2*eps3rt**2
1743 < fac=-expon*(e1+evdwij)*rij_shift
1745 < fac=rij*fac-2*expon*rrij*e_augm
1746 < C Calculate the radial part of the gradient
1750 < C Calculate angular part of the gradient.
1751 < call sc_grad_scale(1.0d0-sss)
1759 < C-----------------------------------------------------------------------------
1760 < subroutine egbv_short(evdw)
1762 < C This subroutine calculates the interaction energy of nonbonded side chains
1763 < C assuming the Gay-Berne-Vorobjev potential of interaction.
1765 < implicit real*8 (a-h,o-z)
1766 < include 'DIMENSIONS'
1767 < include 'COMMON.GEO'
1768 < include 'COMMON.VAR'
1769 < include 'COMMON.LOCAL'
1770 < include 'COMMON.CHAIN'
1771 < include 'COMMON.DERIV'
1772 < include 'COMMON.NAMES'
1773 < include 'COMMON.INTERACT'
1774 < include 'COMMON.IOUNITS'
1775 < include 'COMMON.CALC'
1776 < common /srutu/ icall
1779 < c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1782 < c if (icall.eq.0) lprn=.true.
1784 < do i=iatsc_s,iatsc_e
1790 < dxi=dc_norm(1,nres+i)
1791 < dyi=dc_norm(2,nres+i)
1792 < dzi=dc_norm(3,nres+i)
1793 < c dsci_inv=dsc_inv(itypi)
1794 < dsci_inv=vbld_inv(i+nres)
1796 < C Calculate SC interaction energy.
1798 < do iint=1,nint_gr(i)
1799 < do j=istart(i,iint),iend(i,iint)
1802 < c dscj_inv=dsc_inv(itypj)
1803 < dscj_inv=vbld_inv(j+nres)
1804 < sig0ij=sigma(itypi,itypj)
1805 < r0ij=r0(itypi,itypj)
1806 < chi1=chi(itypi,itypj)
1807 < chi2=chi(itypj,itypi)
1811 < chip12=chip1*chip2
1814 < alf12=0.5D0*(alf1+alf2)
1815 < C For diagnostics only!!!
1828 < dxj=dc_norm(1,nres+j)
1829 < dyj=dc_norm(2,nres+j)
1830 < dzj=dc_norm(3,nres+j)
1831 < rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1834 < sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
1836 < if (sss.gt.0.0d0) then
1838 < C Calculate angle-dependent terms of energy and contributions to their
1842 < sig=sig0ij*dsqrt(sigsq)
1843 < rij_shift=1.0D0/rij-sig+r0ij
1844 < C I hate to put IF's in the loops, but here don't have another choice!!!!
1845 < if (rij_shift.le.0.0D0) then
1850 < c---------------------------------------------------------------
1851 < rij_shift=1.0D0/rij_shift
1852 < fac=rij_shift**expon
1853 < e1=fac*fac*aa(itypi,itypj)
1854 < e2=fac*bb(itypi,itypj)
1855 < evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1856 < eps2der=evdwij*eps3rt
1857 < eps3der=evdwij*eps2rt
1858 < fac_augm=rrij**expon
1859 < e_augm=augm(itypi,itypj)*fac_augm
1860 < evdwij=evdwij*eps2rt*eps3rt
1861 < evdw=evdw+(evdwij+e_augm)*sss
1863 < sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1864 < epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1865 < write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1866 < & restyp(itypi),i,restyp(itypj),j,
1867 < & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1868 < & chi1,chi2,chip1,chip2,
1869 < & eps1,eps2rt**2,eps3rt**2,
1870 < & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1873 < C Calculate gradient components.
1874 < e1=e1*eps1*eps2rt**2*eps3rt**2
1875 < fac=-expon*(e1+evdwij)*rij_shift
1877 < fac=rij*fac-2*expon*rrij*e_augm
1878 < C Calculate the radial part of the gradient
1882 < C Calculate angular part of the gradient.
1883 < call sc_grad_scale(sss)
1891 < C----------------------------------------------------------------------------
1892 < subroutine sc_grad_scale(scalfac)
1894 > subroutine sc_angular
1895 > C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1896 > C om12. Called by ebp, egb, and egbv.
1898 > include 'COMMON.CALC'
1899 > include 'COMMON.IOUNITS'
1903 > om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1904 > om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1905 > om12=dxi*dxj+dyi*dyj+dzi*dzj
1906 > chiom12=chi12*om12
1907 > C Calculate eps1(om12) and its derivative in om12
1908 > faceps1=1.0D0-om12*chiom12
1909 > faceps1_inv=1.0D0/faceps1
1910 > eps1=dsqrt(faceps1_inv)
1911 > C Following variable is eps1*deps1/dom12
1912 > eps1_om12=faceps1_inv*chiom12
1913 > c diagnostics only
1914 > c faceps1_inv=om12
1917 > c write (iout,*) "om12",om12," eps1",eps1
1918 > C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1923 > facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1924 > sigsq=1.0D0-facsig*faceps1_inv
1925 > sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1926 > sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1927 > sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1928 > c diagnostics only
1932 > c sigsq_om12=0.0d0
1933 > c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1934 > c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1936 > C Calculate eps2 and its derivatives in om1, om2, and om12.
1939 > chipom12=chip12*om12
1940 > facp=1.0D0-om12*chipom12
1941 > facp_inv=1.0D0/facp
1942 > facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1943 > c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1944 > c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1945 > C Following variable is the square root of eps2
1946 > eps2rt=1.0D0-facp1*facp_inv
1947 > C Following three variables are the derivatives of the square root of eps
1948 > C in om1, om2, and om12.
1949 > eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1950 > eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1951 > eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1952 > C Evaluate the "asymmetric" factor in the VDW constant, eps3
1953 > eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1954 > c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1955 > c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1956 > c & " eps2rt_om12",eps2rt_om12
1957 > C Calculate whole angle-dependent part of epsilon and contributions
1958 > C to its derivatives
1961 > C----------------------------------------------------------------------------
1962 > subroutine sc_grad
1964 < double precision scalfac
1966 < gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac
1968 > gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1970 < & +((eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1971 < & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv)*scalfac
1973 > & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1974 > & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1976 < & +((eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1977 < & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv)*scalfac
1979 > & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1980 > & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1982 > C-----------------------------------------------------------------------
1983 > subroutine e_softsphere(evdw)
1985 > C This subroutine calculates the interaction energy of nonbonded side chains
1986 > C assuming the LJ potential of interaction.
1988 > implicit real*8 (a-h,o-z)
1989 > include 'DIMENSIONS'
1990 > parameter (accur=1.0d-10)
1991 > include 'COMMON.GEO'
1992 > include 'COMMON.VAR'
1993 > include 'COMMON.LOCAL'
1994 > include 'COMMON.CHAIN'
1995 > include 'COMMON.DERIV'
1996 > include 'COMMON.INTERACT'
1997 > include 'COMMON.TORSION'
1998 > include 'COMMON.SBRIDGE'
1999 > include 'COMMON.NAMES'
2000 > include 'COMMON.IOUNITS'
2001 > include 'COMMON.CONTACTS'
2003 > cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2005 > do i=iatsc_s,iatsc_e
2012 > C Calculate SC interaction energy.
2014 > do iint=1,nint_gr(i)
2015 > cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2016 > cd & 'iend=',iend(i,iint)
2017 > do j=istart(i,iint),iend(i,iint)
2022 > rij=xj*xj+yj*yj+zj*zj
2023 > c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2024 > r0ij=r0(itypi,itypj)
2026 > c print *,i,j,r0ij,dsqrt(rij)
2027 > if (rij.lt.r0ijsq) then
2028 > evdwij=0.25d0*(rij-r0ijsq)**2
2036 > C Calculate the components of the gradient in DC and X
2042 > gvdwx(k,i)=gvdwx(k,i)-gg(k)
2043 > gvdwx(k,j)=gvdwx(k,j)+gg(k)
2047 > gvdwc(l,k)=gvdwc(l,k)+gg(l)
2056 < subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2058 > subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2061 < C This subroutine calculates the average interaction energy and its gradient
2062 < C in the virtual-bond vectors between non-adjacent peptide groups, based on
2063 < C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2064 < C The potential depends both on the distance of peptide-group centers and on
2065 < C the orientation of the CA-CA virtual bonds.
2067 > C Soft-sphere potential of p-p interaction
2069 < dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2070 < & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2071 < double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2072 < & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2073 < common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2074 < c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2076 < double precision scal_el /1.0d0/
2078 < double precision scal_el /0.5d0/
2081 < C 13-go grudnia roku pamietnego...
2082 < double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2083 < & 0.0d0,1.0d0,0.0d0,
2084 < & 0.0d0,0.0d0,1.0d0/
2085 < cd write(iout,*) 'In EELEC'
2087 < cd write(iout,*) 'Type',i
2088 < cd write(iout,*) 'B1',B1(:,i)
2089 < cd write(iout,*) 'B2',B2(:,i)
2090 < cd write(iout,*) 'CC',CC(:,:,i)
2091 < cd write(iout,*) 'DD',DD(:,:,i)
2092 < cd write(iout,*) 'EE',EE(:,:,i)
2094 < cd call check_vecgrad
2096 < if (icheckgrad.eq.1) then
2098 < fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2100 < dc_norm(k,i)=dc(k,i)*fac
2102 < c write (iout,*) 'i',i,' fac',fac
2105 < if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2106 < & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2107 < & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2108 < c call vec_and_deriv
2112 < cd write (iout,*) 'i=',i
2114 < cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2117 < cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2118 < cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2123 > cd write(iout,*) 'In EELEC_soft_sphere'
2128 < cd print '(a)','Enter EELEC'
2129 < cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2131 < gel_loc_loc(i)=0.0d0
2132 < gcorr_loc(i)=0.0d0
2135 < cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2136 < cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2139 < c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2141 < C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2143 < do i=iturn3_start,iturn3_end
2147 < dx_normi=dc_norm(1,i)
2148 < dy_normi=dc_norm(2,i)
2149 < dz_normi=dc_norm(3,i)
2150 < xmedi=c(1,i)+0.5d0*dxi
2151 < ymedi=c(2,i)+0.5d0*dyi
2152 < zmedi=c(3,i)+0.5d0*dzi
2154 < call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
2155 < if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2156 < num_cont_hb(i)=num_conti
2158 < do i=iturn4_start,iturn4_end
2162 < dx_normi=dc_norm(1,i)
2163 < dy_normi=dc_norm(2,i)
2164 < dz_normi=dc_norm(3,i)
2165 < xmedi=c(1,i)+0.5d0*dxi
2166 < ymedi=c(2,i)+0.5d0*dyi
2167 < zmedi=c(3,i)+0.5d0*dzi
2169 < call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
2170 < if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
2171 < num_cont_hb(i)=num_cont_hb(i)+num_conti
2174 < c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2177 < dx_normi=dc_norm(1,i)
2178 < dy_normi=dc_norm(2,i)
2179 < dz_normi=dc_norm(3,i)
2181 < call eelecij_scale(i,j,ees,evdw1,eel_loc)
2186 > if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2187 > r0ij=rpp(iteli,itelj)
2192 > xj=c(1,j)+0.5D0*dxj-xmedi
2193 > yj=c(2,j)+0.5D0*dyj-ymedi
2194 > zj=c(3,j)+0.5D0*dzj-zmedi
2195 > rij=xj*xj+yj*yj+zj*zj
2196 > if (rij.lt.r0ijsq) then
2197 > evdw1ij=0.25d0*(rij-r0ijsq)**2
2203 > evdw1=evdw1+evdw1ij
2205 > C Calculate contributions to the Cartesian gradient.
2211 > ghalf=0.5D0*ggg(k)
2212 > gelc(k,i)=gelc(k,i)+ghalf
2213 > gelc(k,j)=gelc(k,j)+ghalf
2216 > * Loop over residues i+1 thru j-1.
2220 > gelc(l,k)=gelc(l,k)+ggg(l)
2224 < num_cont_hb(i)=num_cont_hb(i)+num_conti
2226 < C-------------------------------------------------------------------------------
2227 < subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
2229 > c------------------------------------------------------------------------------
2230 > subroutine vec_and_deriv
2231 > implicit real*8 (a-h,o-z)
2232 > include 'DIMENSIONS'
2236 > include 'COMMON.IOUNITS'
2237 > include 'COMMON.GEO'
2238 > include 'COMMON.VAR'
2239 > include 'COMMON.LOCAL'
2240 > include 'COMMON.CHAIN'
2241 > include 'COMMON.VECTORS'
2242 > include 'COMMON.SETUP'
2243 > include 'COMMON.TIME1'
2244 > dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2245 > C Compute the local reference systems. For reference system (i), the
2246 > C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2247 > C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2249 > do i=ivec_start,ivec_end
2250 > if (i.eq.nres-1) then
2251 > C Case of the last full residue
2252 > C Compute the Z-axis
2253 > call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2254 > costh=dcos(pi-theta(nres))
2255 > fac=1.0d0/dsqrt(1.0d0-costh*costh)
2257 > uz(k,i)=fac*uz(k,i)
2259 > C Compute the derivatives of uz
2260 > uzder(1,1,1)= 0.0d0
2261 > uzder(2,1,1)=-dc_norm(3,i-1)
2262 > uzder(3,1,1)= dc_norm(2,i-1)
2263 > uzder(1,2,1)= dc_norm(3,i-1)
2264 > uzder(2,2,1)= 0.0d0
2265 > uzder(3,2,1)=-dc_norm(1,i-1)
2266 > uzder(1,3,1)=-dc_norm(2,i-1)
2267 > uzder(2,3,1)= dc_norm(1,i-1)
2268 > uzder(3,3,1)= 0.0d0
2269 > uzder(1,1,2)= 0.0d0
2270 > uzder(2,1,2)= dc_norm(3,i)
2271 > uzder(3,1,2)=-dc_norm(2,i)
2272 > uzder(1,2,2)=-dc_norm(3,i)
2273 > uzder(2,2,2)= 0.0d0
2274 > uzder(3,2,2)= dc_norm(1,i)
2275 > uzder(1,3,2)= dc_norm(2,i)
2276 > uzder(2,3,2)=-dc_norm(1,i)
2277 > uzder(3,3,2)= 0.0d0
2278 > C Compute the Y-axis
2281 > uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2283 > C Compute the derivatives of uy
2286 > uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2287 > & -dc_norm(k,i)*dc_norm(j,i-1)
2288 > uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2290 > uyder(j,j,1)=uyder(j,j,1)-costh
2291 > uyder(j,j,2)=1.0d0+uyder(j,j,2)
2296 > uygrad(l,k,j,i)=uyder(l,k,j)
2297 > uzgrad(l,k,j,i)=uzder(l,k,j)
2301 > call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2302 > call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2303 > call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2304 > call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2307 > C Compute the Z-axis
2308 > call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2309 > costh=dcos(pi-theta(i+2))
2310 > fac=1.0d0/dsqrt(1.0d0-costh*costh)
2312 > uz(k,i)=fac*uz(k,i)
2314 > C Compute the derivatives of uz
2315 > uzder(1,1,1)= 0.0d0
2316 > uzder(2,1,1)=-dc_norm(3,i+1)
2317 > uzder(3,1,1)= dc_norm(2,i+1)
2318 > uzder(1,2,1)= dc_norm(3,i+1)
2319 > uzder(2,2,1)= 0.0d0
2320 > uzder(3,2,1)=-dc_norm(1,i+1)
2321 > uzder(1,3,1)=-dc_norm(2,i+1)
2322 > uzder(2,3,1)= dc_norm(1,i+1)
2323 > uzder(3,3,1)= 0.0d0
2324 > uzder(1,1,2)= 0.0d0
2325 > uzder(2,1,2)= dc_norm(3,i)
2326 > uzder(3,1,2)=-dc_norm(2,i)
2327 > uzder(1,2,2)=-dc_norm(3,i)
2328 > uzder(2,2,2)= 0.0d0
2329 > uzder(3,2,2)= dc_norm(1,i)
2330 > uzder(1,3,2)= dc_norm(2,i)
2331 > uzder(2,3,2)=-dc_norm(1,i)
2332 > uzder(3,3,2)= 0.0d0
2333 > C Compute the Y-axis
2336 > uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2338 > C Compute the derivatives of uy
2341 > uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2342 > & -dc_norm(k,i)*dc_norm(j,i+1)
2343 > uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2345 > uyder(j,j,1)=uyder(j,j,1)-costh
2346 > uyder(j,j,2)=1.0d0+uyder(j,j,2)
2351 > uygrad(l,k,j,i)=uyder(l,k,j)
2352 > uzgrad(l,k,j,i)=uzder(l,k,j)
2356 > call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2357 > call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2358 > call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2359 > call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2363 > vbld_inv_temp(1)=vbld_inv(i+1)
2364 > if (i.lt.nres-1) then
2365 > vbld_inv_temp(2)=vbld_inv(i+2)
2367 > vbld_inv_temp(2)=vbld_inv(i)
2372 > uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2373 > uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2379 > if (nfgtasks.gt.1) then
2380 > time00=MPI_Wtime()
2381 > c print *,"Processor",fg_rank,kolor," ivec_start",ivec_start,
2382 > c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2383 > c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2384 > call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank),
2385 > & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2387 > call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank),
2388 > & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2390 > call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2391 > & ivec_count(fg_rank),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2392 > & ivec_displ(0),MPI_UYZGRAD,FG_COMM,IERR)
2393 > call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2394 > & ivec_count(fg_rank),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2395 > & ivec_displ(0),MPI_UYZGRAD,FG_COMM,IERR)
2397 > time_gather=time_gather+MPI_Wtime()-time00
2398 > c if (fg_rank.eq.0) then
2399 > c write (iout,*) "Arrays UY and UZ"
2401 > c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2402 > c & (uz(k,i),k=1,3)
2408 > C-----------------------------------------------------------------------------
2409 > subroutine check_vecgrad
2410 > implicit real*8 (a-h,o-z)
2411 > include 'DIMENSIONS'
2412 > include 'COMMON.IOUNITS'
2413 > include 'COMMON.GEO'
2414 > include 'COMMON.VAR'
2415 > include 'COMMON.LOCAL'
2416 > include 'COMMON.CHAIN'
2417 > include 'COMMON.VECTORS'
2418 > dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2419 > dimension uyt(3,maxres),uzt(3,maxres)
2420 > dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2421 > double precision delta /1.0d-7/
2422 > call vec_and_deriv
2424 > crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2425 > crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2426 > crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2427 > cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2428 > cd & (dc_norm(if90,i),if90=1,3)
2429 > cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2430 > cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2431 > cd write(iout,'(a)')
2437 > uygradt(l,k,j,i)=uygrad(l,k,j,i)
2438 > uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2443 > call vec_and_deriv
2451 > cd write (iout,*) 'i=',i
2453 > erij(k)=dc_norm(k,i)
2457 > dc_norm(k,i)=erij(k)
2459 > dc_norm(j,i)=dc_norm(j,i)+delta
2460 > c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2462 > c dc_norm(k,i)=dc_norm(k,i)/fac
2464 > c write (iout,*) (dc_norm(k,i),k=1,3)
2465 > c write (iout,*) (erij(k),k=1,3)
2466 > call vec_and_deriv
2468 > uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2469 > uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2470 > uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2471 > uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2473 > c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2474 > c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2475 > c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2478 > dc_norm(k,i)=erij(k)
2481 > cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2482 > cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2483 > cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2484 > cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2485 > cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2486 > cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2487 > cd write (iout,'(a)')
2492 > C--------------------------------------------------------------------------
2493 > subroutine set_matrices
2494 > implicit real*8 (a-h,o-z)
2495 > include 'DIMENSIONS'
2496 > include 'COMMON.IOUNITS'
2497 > include 'COMMON.GEO'
2498 > include 'COMMON.VAR'
2499 > include 'COMMON.LOCAL'
2500 > include 'COMMON.CHAIN'
2501 > include 'COMMON.DERIV'
2502 > include 'COMMON.INTERACT'
2503 > include 'COMMON.CONTACTS'
2504 > include 'COMMON.TORSION'
2505 > include 'COMMON.VECTORS'
2506 > include 'COMMON.FFIELD'
2507 > double precision auxvec(2),auxmat(2,2)
2509 > C Compute the virtual-bond-torsional-angle dependent quantities needed
2510 > C to calculate the el-loc multibody terms of various order.
2513 > if (i .lt. nres+1) then
2520 > sin2=dsin(2*phi(i))
2521 > cos2=dcos(2*phi(i))
2524 > obrot2(1,i-2)=cos2
2525 > obrot2(2,i-2)=sin2
2530 > Ug2(1,1,i-2)=-cos2
2531 > Ug2(1,2,i-2)=-sin2
2532 > Ug2(2,1,i-2)=-sin2
2533 > Ug2(2,2,i-2)= cos2
2537 > obrot(1,i-2)=1.0d0
2538 > obrot(2,i-2)=0.0d0
2539 > obrot2(1,i-2)=0.0d0
2540 > obrot2(2,i-2)=0.0d0
2545 > Ug2(1,1,i-2)=0.0d0
2546 > Ug2(1,2,i-2)=0.0d0
2547 > Ug2(2,1,i-2)=0.0d0
2548 > Ug2(2,2,i-2)=0.0d0
2550 > if (i .gt. 3 .and. i .lt. nres+1) then
2551 > obrot_der(1,i-2)=-sin1
2552 > obrot_der(2,i-2)= cos1
2553 > Ugder(1,1,i-2)= sin1
2554 > Ugder(1,2,i-2)=-cos1
2555 > Ugder(2,1,i-2)=-cos1
2556 > Ugder(2,2,i-2)=-sin1
2559 > obrot2_der(1,i-2)=-dwasin2
2560 > obrot2_der(2,i-2)= dwacos2
2561 > Ug2der(1,1,i-2)= dwasin2
2562 > Ug2der(1,2,i-2)=-dwacos2
2563 > Ug2der(2,1,i-2)=-dwacos2
2564 > Ug2der(2,2,i-2)=-dwasin2
2566 > obrot_der(1,i-2)=0.0d0
2567 > obrot_der(2,i-2)=0.0d0
2568 > Ugder(1,1,i-2)=0.0d0
2569 > Ugder(1,2,i-2)=0.0d0
2570 > Ugder(2,1,i-2)=0.0d0
2571 > Ugder(2,2,i-2)=0.0d0
2572 > obrot2_der(1,i-2)=0.0d0
2573 > obrot2_der(2,i-2)=0.0d0
2574 > Ug2der(1,1,i-2)=0.0d0
2575 > Ug2der(1,2,i-2)=0.0d0
2576 > Ug2der(2,1,i-2)=0.0d0
2577 > Ug2der(2,2,i-2)=0.0d0
2579 > c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2580 > if (i.gt. nnt+2 .and. i.lt.nct+2) then
2581 > iti = itortyp(itype(i-2))
2585 > c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2586 > if (i.gt. nnt+1 .and. i.lt.nct+1) then
2587 > iti1 = itortyp(itype(i-1))
2591 > cd write (iout,*) '*******i',i,' iti1',iti
2592 > cd write (iout,*) 'b1',b1(:,iti)
2593 > cd write (iout,*) 'b2',b2(:,iti)
2594 > cd write (iout,*) 'Ug',Ug(:,:,i-2)
2595 > c if (i .gt. iatel_s+2) then
2596 > if (i .gt. nnt+2) then
2597 > call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2598 > call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2599 > call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2600 > call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2601 > call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2602 > call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2603 > call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2607 > Ctobr(k,i-2)=0.0d0
2608 > Dtobr2(k,i-2)=0.0d0
2610 > EUg(l,k,i-2)=0.0d0
2611 > CUg(l,k,i-2)=0.0d0
2612 > DUg(l,k,i-2)=0.0d0
2613 > DtUg2(l,k,i-2)=0.0d0
2617 > call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2618 > call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2619 > call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2620 > call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2621 > call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2622 > call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2623 > call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2625 > muder(k,i-2)=Ub2der(k,i-2)
2627 > c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2628 > if (i.gt. nnt+1 .and. i.lt.nct+1) then
2629 > iti1 = itortyp(itype(i-1))
2634 > mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2636 > C Vectors and matrices dependent on a single virtual-bond dihedral.
2637 > call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2638 > call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2639 > call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2640 > call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2641 > call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2642 > call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2643 > call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2644 > call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2645 > call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2646 > cd write (iout,*) 'mu ',mu(:,i-2)
2647 > cd write (iout,*) 'mu1',mu1(:,i-2)
2648 > cd write (iout,*) 'mu2',mu2(:,i-2)
2650 > C Matrices dependent on two consecutive virtual-bond dihedrals.
2651 > C The order of matrices is from left to right.
2653 > call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2654 > call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2655 > call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2656 > call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2657 > call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2658 > call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2659 > call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2660 > call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2663 > cd iti = itortyp(itype(i))
2664 > cd write (iout,*) i
2666 > cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2667 > cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2672 > C--------------------------------------------------------------------------
2673 > subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2675 < common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2676 < & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2679 > common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2684 < if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2685 < aaa=app(iteli,itelj)
2686 < bbb=bpp(iteli,itelj)
2687 < ael6i=ael6(iteli,itelj)
2688 < ael3i=ael3(iteli,itelj)
2689 < C Diagnostics only!!!
2698 < dx_normj=dc_norm(1,j)
2699 < dy_normj=dc_norm(2,j)
2700 < dz_normj=dc_norm(3,j)
2701 < xj=c(1,j)+0.5D0*dxj-xmedi
2702 < yj=c(2,j)+0.5D0*dyj-ymedi
2703 < zj=c(3,j)+0.5D0*dzj-zmedi
2704 < rij=xj*xj+yj*yj+zj*zj
2708 < c For extracting the short-range part of Evdwpp
2709 < sss=sscale(rij/rpp(iteli,itelj))
2713 < cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2714 < cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2715 < cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2716 < fac=cosa-3.0D0*cosb*cosg
2718 < c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2719 < if (j.eq.i+2) ev1=scal_el*ev1
2724 < el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2727 < C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2728 < ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2730 < evdw1=evdw1+evdwij*(1.0d0-sss)
2731 < cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2732 < cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2734 > cd write(iout,*) 'In EELEC'
2736 > cd write(iout,*) 'Type',i
2737 > cd write(iout,*) 'B1',B1(:,i)
2738 > cd write(iout,*) 'B2',B2(:,i)
2739 > cd write(iout,*) 'CC',CC(:,:,i)
2740 > cd write(iout,*) 'DD',DD(:,:,i)
2741 > cd write(iout,*) 'EE',EE(:,:,i)
2743 > cd call check_vecgrad
2745 > if (icheckgrad.eq.1) then
2747 > fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2749 > dc_norm(k,i)=dc(k,i)*fac
2751 > c write (iout,*) 'i',i,' fac',fac
2754 > if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2755 > & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2756 > & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2757 > c call vec_and_deriv
2761 > cd write (iout,*) 'i=',i
2763 > cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2766 > cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2767 > cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2780 > cd print '(a)','Enter EELEC'
2781 > cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2783 > gel_loc_loc(i)=0.0d0
2784 > gcorr_loc(i)=0.0d0
2786 > do i=iatel_s,iatel_e
2790 > dx_normi=dc_norm(1,i)
2791 > dy_normi=dc_norm(2,i)
2792 > dz_normi=dc_norm(3,i)
2793 > xmedi=c(1,i)+0.5d0*dxi
2794 > ymedi=c(2,i)+0.5d0*dyi
2795 > zmedi=c(3,i)+0.5d0*dzi
2797 > c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2798 > do j=ielstart(i),ielend(i)
2802 > if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2803 > aaa=app(iteli,itelj)
2804 > bbb=bpp(iteli,itelj)
2805 > ael6i=ael6(iteli,itelj)
2806 > ael3i=ael3(iteli,itelj)
2807 > C Diagnostics only!!!
2816 > dx_normj=dc_norm(1,j)
2817 > dy_normj=dc_norm(2,j)
2818 > dz_normj=dc_norm(3,j)
2819 > xj=c(1,j)+0.5D0*dxj-xmedi
2820 > yj=c(2,j)+0.5D0*dyj-ymedi
2821 > zj=c(3,j)+0.5D0*dzj-zmedi
2822 > rij=xj*xj+yj*yj+zj*zj
2828 > cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2829 > cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2830 > cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2831 > fac=cosa-3.0D0*cosb*cosg
2833 > c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2834 > if (j.eq.i+2) ev1=scal_el*ev1
2839 > el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2842 > C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2843 > ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2845 > evdw1=evdw1+evdwij
2846 > cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2847 > cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2849 < facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)
2851 > facvdw=-6*rrmij*(ev1+evdwij)
2853 < facvdw=(ev1+evdwij)*(1.0d0-sss)
2857 > if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2858 > C Contributions from turns
2863 > call eturn34(i,j,eello_turn3,eello_turn4)
2867 > num_cont_hb(i)=num_conti
2870 > cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2871 > cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2873 > c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2874 > ccc eel_loc=eel_loc+eello_turn3
2876 < C-----------------------------------------------------------------------
2877 < subroutine evdwpp_long(evdw1)
2882 > C-----------------------------------------------------------------------------
2883 > subroutine eturn34(i,j,eello_turn3,eello_turn4)
2884 > C Third- and fourth-order contributions from turns
2886 < include 'COMMON.CONTROL'
2888 > include 'COMMON.CONTROL'
2890 < c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2892 < double precision scal_el /1.0d0/
2894 < double precision scal_el /0.5d0/
2897 < do i=iatel_s,iatel_e
2901 < dx_normi=dc_norm(1,i)
2902 < dy_normi=dc_norm(2,i)
2903 < dz_normi=dc_norm(3,i)
2904 < xmedi=c(1,i)+0.5d0*dxi
2905 < ymedi=c(2,i)+0.5d0*dyi
2906 < zmedi=c(3,i)+0.5d0*dzi
2908 < c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2909 < do j=ielstart(i),ielend(i)
2913 < if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2914 < aaa=app(iteli,itelj)
2915 < bbb=bpp(iteli,itelj)
2919 < dx_normj=dc_norm(1,j)
2920 < dy_normj=dc_norm(2,j)
2921 < dz_normj=dc_norm(3,j)
2922 < xj=c(1,j)+0.5D0*dxj-xmedi
2923 < yj=c(2,j)+0.5D0*dyj-ymedi
2924 < zj=c(3,j)+0.5D0*dzj-zmedi
2925 < rij=xj*xj+yj*yj+zj*zj
2928 < sss=sscale(rij/rpp(iteli,itelj))
2929 < if (sss.lt.1.0d0) then
2934 < c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2935 < if (j.eq.i+2) ev1=scal_el*ev1
2938 < if (energy_dec) then
2939 < write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
2940 < write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2942 < evdw1=evdw1+evdwij*(1.0d0-sss)
2944 > double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2945 > & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2946 > & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2947 > double precision agg(3,4),aggi(3,4),aggi1(3,4),
2948 > & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
2949 > common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2950 > if (j.eq.i+2) then
2951 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2953 < C Calculate contributions to the Cartesian gradient.
2955 > C Third-order contributions
2962 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2963 > cd call checkint_turn3(i,a_temp,eello_turn3_num)
2964 > call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2965 > call transpose2(auxmat(1,1),auxmat1(1,1))
2966 > call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2967 > eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2968 > if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2969 > & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
2970 > cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2971 > cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2972 > cd & ' eello_turn3_num',4*eello_turn3_num
2973 > C Derivatives in gamma(i)
2974 > call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2975 > call transpose2(auxmat2(1,1),auxmat3(1,1))
2976 > call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
2977 > gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2978 > C Derivatives in gamma(i+1)
2979 > call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2980 > call transpose2(auxmat2(1,1),auxmat3(1,1))
2981 > call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
2982 > gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2983 > & +0.5d0*(pizda(1,1)+pizda(2,2))
2984 > C Cartesian derivatives
2986 > a_temp(1,1)=aggi(l,1)
2987 > a_temp(1,2)=aggi(l,2)
2988 > a_temp(2,1)=aggi(l,3)
2989 > a_temp(2,2)=aggi(l,4)
2990 > call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2991 > gcorr3_turn(l,i)=gcorr3_turn(l,i)
2992 > & +0.5d0*(pizda(1,1)+pizda(2,2))
2993 > a_temp(1,1)=aggi1(l,1)
2994 > a_temp(1,2)=aggi1(l,2)
2995 > a_temp(2,1)=aggi1(l,3)
2996 > a_temp(2,2)=aggi1(l,4)
2997 > call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2998 > gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2999 > & +0.5d0*(pizda(1,1)+pizda(2,2))
3000 > a_temp(1,1)=aggj(l,1)
3001 > a_temp(1,2)=aggj(l,2)
3002 > a_temp(2,1)=aggj(l,3)
3003 > a_temp(2,2)=aggj(l,4)
3004 > call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3005 > gcorr3_turn(l,j)=gcorr3_turn(l,j)
3006 > & +0.5d0*(pizda(1,1)+pizda(2,2))
3007 > a_temp(1,1)=aggj1(l,1)
3008 > a_temp(1,2)=aggj1(l,2)
3009 > a_temp(2,1)=aggj1(l,3)
3010 > a_temp(2,2)=aggj1(l,4)
3011 > call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3012 > gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3013 > & +0.5d0*(pizda(1,1)+pizda(2,2))
3015 > else if (j.eq.i+3) then
3016 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3018 < facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)
3024 < ghalf=0.5D0*ggg(k)
3025 < gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3026 < gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3029 < * Loop over residues i+1 thru j-1.
3033 < gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3040 > C Fourth-order contributions
3048 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3049 > cd call checkint_turn4(i,a_temp,eello_turn4_num)
3050 > iti1=itortyp(itype(i+1))
3051 > iti2=itortyp(itype(i+2))
3052 > iti3=itortyp(itype(i+3))
3053 > call transpose2(EUg(1,1,i+1),e1t(1,1))
3054 > call transpose2(Eug(1,1,i+2),e2t(1,1))
3055 > call transpose2(Eug(1,1,i+3),e3t(1,1))
3056 > call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3057 > call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3058 > s1=scalar2(b1(1,iti2),auxvec(1))
3059 > call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3060 > call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3061 > s2=scalar2(b1(1,iti1),auxvec(1))
3062 > call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3063 > call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3064 > s3=0.5d0*(pizda(1,1)+pizda(2,2))
3065 > eello_turn4=eello_turn4-(s1+s2+s3)
3066 > if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3067 > & 'eturn4',i,j,-(s1+s2+s3)
3068 > cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3069 > cd & ' eello_turn4_num',8*eello_turn4_num
3070 > C Derivatives in gamma(i)
3071 > call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3072 > call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3073 > call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3074 > s1=scalar2(b1(1,iti2),auxvec(1))
3075 > call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3076 > s3=0.5d0*(pizda(1,1)+pizda(2,2))
3077 > gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3078 > C Derivatives in gamma(i+1)
3079 > call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3080 > call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3081 > s2=scalar2(b1(1,iti1),auxvec(1))
3082 > call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3083 > call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3084 > s3=0.5d0*(pizda(1,1)+pizda(2,2))
3085 > gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3086 > C Derivatives in gamma(i+2)
3087 > call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3088 > call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3089 > s1=scalar2(b1(1,iti2),auxvec(1))
3090 > call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3091 > call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3092 > s2=scalar2(b1(1,iti1),auxvec(1))
3093 > call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3094 > call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3095 > s3=0.5d0*(pizda(1,1)+pizda(2,2))
3096 > gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3097 > C Cartesian derivatives
3098 > C Derivatives of this turn contributions in DC(i+2)
3099 > if (j.lt.nres-1) then
3101 > a_temp(1,1)=agg(l,1)
3102 > a_temp(1,2)=agg(l,2)
3103 > a_temp(2,1)=agg(l,3)
3104 > a_temp(2,2)=agg(l,4)
3105 > call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3106 > call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3107 > s1=scalar2(b1(1,iti2),auxvec(1))
3108 > call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3109 > call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3110 > s2=scalar2(b1(1,iti1),auxvec(1))
3111 > call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3112 > call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3113 > s3=0.5d0*(pizda(1,1)+pizda(2,2))
3114 > ggg(l)=-(s1+s2+s3)
3115 > gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3118 > C Remaining derivatives of this turn contribution
3120 > a_temp(1,1)=aggi(l,1)
3121 > a_temp(1,2)=aggi(l,2)
3122 > a_temp(2,1)=aggi(l,3)
3123 > a_temp(2,2)=aggi(l,4)
3124 > call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3125 > call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3126 > s1=scalar2(b1(1,iti2),auxvec(1))
3127 > call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3128 > call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3129 > s2=scalar2(b1(1,iti1),auxvec(1))
3130 > call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3131 > call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3132 > s3=0.5d0*(pizda(1,1)+pizda(2,2))
3133 > gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3134 > a_temp(1,1)=aggi1(l,1)
3135 > a_temp(1,2)=aggi1(l,2)
3136 > a_temp(2,1)=aggi1(l,3)
3137 > a_temp(2,2)=aggi1(l,4)
3138 > call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3139 > call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3140 > s1=scalar2(b1(1,iti2),auxvec(1))
3141 > call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3142 > call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3143 > s2=scalar2(b1(1,iti1),auxvec(1))
3144 > call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3145 > call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3146 > s3=0.5d0*(pizda(1,1)+pizda(2,2))
3147 > gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3148 > a_temp(1,1)=aggj(l,1)
3149 > a_temp(1,2)=aggj(l,2)
3150 > a_temp(2,1)=aggj(l,3)
3151 > a_temp(2,2)=aggj(l,4)
3152 > call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3153 > call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3154 > s1=scalar2(b1(1,iti2),auxvec(1))
3155 > call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3156 > call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3157 > s2=scalar2(b1(1,iti1),auxvec(1))
3158 > call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3159 > call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3160 > s3=0.5d0*(pizda(1,1)+pizda(2,2))
3161 > gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3162 > a_temp(1,1)=aggj1(l,1)
3163 > a_temp(1,2)=aggj1(l,2)
3164 > a_temp(2,1)=aggj1(l,3)
3165 > a_temp(2,2)=aggj1(l,4)
3166 > call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3167 > call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3168 > s1=scalar2(b1(1,iti2),auxvec(1))
3169 > call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3170 > call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3171 > s2=scalar2(b1(1,iti1),auxvec(1))
3172 > call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3173 > call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3174 > s3=0.5d0*(pizda(1,1)+pizda(2,2))
3175 > gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3179 < C-----------------------------------------------------------------------
3180 < subroutine evdwpp_short(evdw1)
3182 > C-----------------------------------------------------------------------------
3183 > subroutine vecpr(u,v,w)
3184 > implicit real*8(a-h,o-z)
3185 > dimension u(3),v(3),w(3)
3186 > w(1)=u(2)*v(3)-u(3)*v(2)
3187 > w(2)=-u(1)*v(3)+u(3)*v(1)
3188 > w(3)=u(1)*v(2)-u(2)*v(1)
3191 > C-----------------------------------------------------------------------------
3192 > subroutine unormderiv(u,ugrad,unorm,ungrad)
3193 > C This subroutine computes the derivatives of a normalized vector u, given
3194 > C the derivatives computed without normalization conditions, ugrad. Returns
3197 > double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3198 > double precision vec(3)
3199 > double precision scalar
3201 > c write (2,*) 'ugrad',ugrad
3202 > c write (2,*) 'u',u
3204 > vec(i)=scalar(ugrad(1,i),u(1))
3206 > c write (2,*) 'vec',vec
3209 > ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3212 > c write (2,*) 'ungrad',ungrad
3215 > C-----------------------------------------------------------------------------
3216 > subroutine escp_soft_sphere(evdw2,evdw2_14)
3218 > C This subroutine calculates the excluded-volume interaction energy between
3219 > C peptide-group centers and side chains and its gradient in virtual-bond and
3220 > C side-chain vectors.
3225 < include 'COMMON.CONTROL'
3226 < include 'COMMON.IOUNITS'
3228 < include 'COMMON.CONTACTS'
3229 < include 'COMMON.TORSION'
3230 < include 'COMMON.VECTORS'
3233 < c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3235 < double precision scal_el /1.0d0/
3237 < double precision scal_el /0.5d0/
3240 < do i=iatel_s,iatel_e
3244 < dx_normi=dc_norm(1,i)
3245 < dy_normi=dc_norm(2,i)
3246 < dz_normi=dc_norm(3,i)
3247 < xmedi=c(1,i)+0.5d0*dxi
3248 < ymedi=c(2,i)+0.5d0*dyi
3249 < zmedi=c(3,i)+0.5d0*dzi
3251 < c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3252 < do j=ielstart(i),ielend(i)
3256 < if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3257 < aaa=app(iteli,itelj)
3258 < bbb=bpp(iteli,itelj)
3262 < dx_normj=dc_norm(1,j)
3263 < dy_normj=dc_norm(2,j)
3264 < dz_normj=dc_norm(3,j)
3265 < xj=c(1,j)+0.5D0*dxj-xmedi
3266 < yj=c(2,j)+0.5D0*dyj-ymedi
3267 < zj=c(3,j)+0.5D0*dzj-zmedi
3268 < rij=xj*xj+yj*yj+zj*zj
3271 < sss=sscale(rij/rpp(iteli,itelj))
3272 < if (sss.gt.0.0d0) then
3277 < c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3278 < if (j.eq.i+2) ev1=scal_el*ev1
3281 < if (energy_dec) then
3282 < write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3283 < write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3285 < evdw1=evdw1+evdwij*sss
3287 < C Calculate contributions to the Cartesian gradient.
3289 < facvdw=-6*rrmij*(ev1+evdwij)*sss
3295 < ghalf=0.5D0*ggg(k)
3296 < gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3297 < gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3300 < * Loop over residues i+1 thru j-1.
3304 < gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3312 < C-----------------------------------------------------------------------------
3313 < subroutine escp_long(evdw2,evdw2_14)
3315 < C This subroutine calculates the excluded-volume interaction energy between
3316 < C peptide-group centers and side chains and its gradient in virtual-bond and
3317 < C side-chain vectors.
3319 < implicit real*8 (a-h,o-z)
3320 < include 'DIMENSIONS'
3321 < include 'COMMON.GEO'
3322 < include 'COMMON.VAR'
3323 < include 'COMMON.LOCAL'
3324 < include 'COMMON.CHAIN'
3325 < include 'COMMON.DERIV'
3326 < include 'COMMON.INTERACT'
3327 < include 'COMMON.FFIELD'
3328 < include 'COMMON.IOUNITS'
3329 < include 'COMMON.CONTROL'
3331 > include 'COMMON.IOUNITS'
3332 > include 'COMMON.CONTROL'
3336 < rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3338 < sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
3340 < if (sss.lt.1.0d0) then
3343 < e1=fac*fac*aad(itypj,iteli)
3344 < e2=fac*bad(itypj,iteli)
3345 < if (iabs(j-i) .le. 2) then
3348 < evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)
3351 < evdw2=evdw2+evdwij*(1.0d0-sss)
3352 < if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3353 < & 'evdw2',i,j,evdwij
3355 > rij=xj*xj+yj*yj+zj*zj
3358 > if (rij.lt.r0ijsq) then
3359 > evdwij=0.25d0*(rij-r0ijsq)**2
3365 > evdw2=evdw2+evdwij
3367 < fac=-(evdwij+e1)*rrij*(1.0d0-sss)
3372 < cd write (iout,*) 'j<i'
3378 > cd write (iout,*) 'j<i'
3386 < cd write (iout,*) 'j>i'
3389 < C Uncomment following line for SC-p interactions
3390 < c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3396 > cd write (iout,*) 'j>i'
3398 < gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3401 > C Uncomment following line for SC-p interactions
3402 > c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3404 < kstart=min0(i+1,j)
3405 < kend=max0(i-1,j-1)
3409 > gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3411 > kstart=min0(i+1,j)
3412 > kend=max0(i-1,j-1)
3416 < gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3421 > gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3431 < gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3432 < gradx_scp(j,i)=expon*gradx_scp(j,i)
3435 < C******************************************************************************
3439 < C To save time the factor EXPON has been extracted from ALL components
3440 < C of GVDWC and GRADX. Remember to multiply them by this factor before further
3443 < C******************************************************************************
3445 < subroutine escp_short(evdw2,evdw2_14)
3447 > subroutine escp(evdw2,evdw2_14)
3450 < sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
3452 < if (sss.gt.0.0d0) then
3455 < e1=fac*fac*aad(itypj,iteli)
3456 < e2=fac*bad(itypj,iteli)
3457 < if (iabs(j-i) .le. 2) then
3460 < evdw2_14=evdw2_14+(e1+e2)*sss
3463 < evdw2=evdw2+evdwij*sss
3464 < if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3465 < & 'evdw2',i,j,evdwij
3468 > e1=fac*fac*aad(itypj,iteli)
3469 > e2=fac*bad(itypj,iteli)
3470 > if (iabs(j-i) .le. 2) then
3473 > evdw2_14=evdw2_14+e1+e2
3476 > evdw2=evdw2+evdwij
3477 > if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3478 > & 'evdw2',i,j,evdwij
3480 < fac=-(evdwij+e1)*rrij*sss
3485 < cd write (iout,*) 'j<i'
3487 > fac=-(evdwij+e1)*rrij
3492 > cd write (iout,*) 'j<i'
3500 < cd write (iout,*) 'j>i'
3503 < C Uncomment following line for SC-p interactions
3504 < c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3510 > cd write (iout,*) 'j>i'
3512 < gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3515 > C Uncomment following line for SC-p interactions
3516 > c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3518 < kstart=min0(i+1,j)
3519 < kend=max0(i-1,j-1)
3523 > gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3525 > kstart=min0(i+1,j)
3526 > kend=max0(i-1,j-1)
3530 < gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3535 > gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3543 > C--------------------------------------------------------------------------
3544 > subroutine edis(ehpb)
3546 > C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3548 > implicit real*8 (a-h,o-z)
3549 > include 'DIMENSIONS'
3550 > include 'COMMON.SBRIDGE'
3551 > include 'COMMON.CHAIN'
3552 > include 'COMMON.DERIV'
3553 > include 'COMMON.VAR'
3554 > include 'COMMON.INTERACT'
3557 > cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3558 > cd print *,'link_start=',link_start,' link_end=',link_end
3559 > if (link_end.eq.0) return
3560 > do i=link_start,link_end
3561 > C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3562 > C CA-CA distance used in regularization of structure.
3565 > C iii and jjj point to the residues for which the distance is assigned.
3566 > if (ii.gt.nres) then
3573 > C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3574 > C distance and angle dependent SS bond potential.
3575 > if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
3576 > call ssbond_ene(iii,jjj,eij)
3579 > C Calculate the distance between the two points and its difference from the
3580 > C target distance.
3583 > C Get the force constant corresponding to this distance.
3585 > C Calculate the contribution to energy.
3586 > ehpb=ehpb+waga*rdis*rdis
3588 > C Evaluate gradient.
3591 > cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3592 > cd & ' waga=',waga,' fac=',fac
3594 > ggg(j)=fac*(c(j,jj)-c(j,ii))
3596 > cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3597 > C If this is a SC-SC distance, we need to calculate the contributions to the
3598 > C Cartesian gradient in the SC vectors (ghpbx).
3599 > if (iii.lt.ii) then
3601 > ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3602 > ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3607 > ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3615 > C--------------------------------------------------------------------------
3616 > subroutine ssbond_ene(i,j,eij)
3618 > C Calculate the distance and angle dependent SS-bond potential energy
3619 > C using a free-energy function derived based on RHF/6-31G** ab initio
3620 > C calculations of diethyl disulfide.
3622 > C A. Liwo and U. Kozlowska, 11/24/03
3624 > implicit real*8 (a-h,o-z)
3625 > include 'DIMENSIONS'
3626 > include 'COMMON.SBRIDGE'
3627 > include 'COMMON.CHAIN'
3628 > include 'COMMON.DERIV'
3629 > include 'COMMON.LOCAL'
3630 > include 'COMMON.INTERACT'
3631 > include 'COMMON.VAR'
3632 > include 'COMMON.IOUNITS'
3633 > double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3638 > dxi=dc_norm(1,nres+i)
3639 > dyi=dc_norm(2,nres+i)
3640 > dzi=dc_norm(3,nres+i)
3641 > dsci_inv=dsc_inv(itypi)
3643 > dscj_inv=dsc_inv(itypj)
3647 > dxj=dc_norm(1,nres+j)
3648 > dyj=dc_norm(2,nres+j)
3649 > dzj=dc_norm(3,nres+j)
3650 > rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3655 > om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3656 > om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3657 > om12=dxi*dxj+dyi*dyj+dzi*dzj
3659 > dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3660 > dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3666 > deltat12=om2-om1+2.0d0
3667 > cosphi=om12-om1*om2
3668 > eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3669 > & +akct*deltad*deltat12
3670 > & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3671 > c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3672 > c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3673 > c & " deltat12",deltat12," eij",eij
3674 > ed=2*akcm*deltad+akct*deltat12
3676 > pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3677 > eom1=-2*akth*deltat1-pom1-om2*pom2
3678 > eom2= 2*akth*deltat2+pom1-om1*pom2
3681 > gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3684 > ghpbx(k,i)=ghpbx(k,i)-gg(k)
3685 > & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3686 > ghpbx(k,j)=ghpbx(k,j)+gg(k)
3687 > & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3690 > C Calculate the components of the gradient in DC and X
3694 > ghpbc(l,k)=ghpbc(l,k)+gg(l)
3699 > C--------------------------------------------------------------------------
3700 > subroutine ebond(estr)
3702 > c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3704 > implicit real*8 (a-h,o-z)
3705 > include 'DIMENSIONS'
3706 > include 'COMMON.LOCAL'
3707 > include 'COMMON.GEO'
3708 > include 'COMMON.INTERACT'
3709 > include 'COMMON.DERIV'
3710 > include 'COMMON.VAR'
3711 > include 'COMMON.CHAIN'
3712 > include 'COMMON.IOUNITS'
3713 > include 'COMMON.NAMES'
3714 > include 'COMMON.FFIELD'
3715 > include 'COMMON.CONTROL'
3716 > include 'COMMON.SETUP'
3717 > double precision u(3),ud(3)
3719 > do i=ibondp_start,ibondp_end
3720 > diff = vbld(i)-vbldp0
3721 > c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3722 > estr=estr+diff*diff
3724 > gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3726 > c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
3728 > estr=0.5d0*AKP*estr
3730 > c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3732 > do i=ibond_start,ibond_end
3734 > if (iti.ne.10) then
3735 > nbi=nbondterm(iti)
3736 > if (nbi.eq.1) then
3737 > diff=vbld(i+nres)-vbldsc0(1,iti)
3738 > c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3739 > c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3740 > estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3742 > gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3746 > diff=vbld(i+nres)-vbldsc0(j,iti)
3747 > ud(j)=aksc(j,iti)*diff
3748 > u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3761 > uprod1=uprod1*u(k)
3762 > uprod2=uprod2*u(k)*u(k)
3766 > usumsqder=usumsqder+ud(j)*uprod2
3768 > estr=estr+uprod/usum
3770 > gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3777 > #ifdef CRYST_THETA
3778 > C--------------------------------------------------------------------------
3779 > subroutine ebend(etheta)
3781 > C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3782 > C angles gamma and its derivatives in consecutive thetas and gammas.
3784 > implicit real*8 (a-h,o-z)
3785 > include 'DIMENSIONS'
3786 > include 'COMMON.LOCAL'
3787 > include 'COMMON.GEO'
3788 > include 'COMMON.INTERACT'
3789 > include 'COMMON.DERIV'
3790 > include 'COMMON.VAR'
3791 > include 'COMMON.CHAIN'
3792 > include 'COMMON.IOUNITS'
3793 > include 'COMMON.NAMES'
3794 > include 'COMMON.FFIELD'
3795 > include 'COMMON.CONTROL'
3796 > common /calcthet/ term1,term2,termm,diffak,ratak,
3797 > & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3798 > & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3799 > double precision y(2),z(2)
3801 > c time11=dexp(-2*time)
3804 > c write (*,'(a,i2)') 'EBEND ICG=',icg
3805 > do i=ithet_start,ithet_end
3806 > C Zero the energy function and its derivative at 0 or pi.
3807 > call splinthet(theta(i),0.5d0*delta,ss,ssd)
3812 > if (phii.ne.phii) phii=150.0
3822 > if (i.lt.nres) then
3825 > if (phii1.ne.phii1) phii1=150.0
3826 > phii1=pinorm(phii1)
3837 > C Calculate the "mean" value of theta from the part of the distribution
3838 > C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3839 > C In following comments this theta will be referred to as t_c.
3840 > thet_pred_mean=0.0d0
3842 > athetk=athet(k,it)
3843 > bthetk=bthet(k,it)
3844 > thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3846 > dthett=thet_pred_mean*ssd
3847 > thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3848 > C Derivatives of the "mean" values in gamma1 and gamma2.
3849 > dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3850 > dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3851 > if (theta(i).gt.pi-delta) then
3852 > call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3854 > call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3855 > call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3856 > call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3858 > call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3860 > else if (theta(i).lt.delta) then
3861 > call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3862 > call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3863 > call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3865 > call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3866 > call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3869 > call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3872 > etheta=etheta+ethetai
3873 > if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
3874 > & 'ebend',i,ethetai
3875 > if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3876 > if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3877 > gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3879 > C Ufff.... We've done all this!!!
3882 > C---------------------------------------------------------------------------
3883 > subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3885 > implicit real*8 (a-h,o-z)
3886 > include 'DIMENSIONS'
3887 > include 'COMMON.LOCAL'
3888 > include 'COMMON.IOUNITS'
3889 > common /calcthet/ term1,term2,termm,diffak,ratak,
3890 > & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3891 > & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3892 > C Calculate the contributions to both Gaussian lobes.
3893 > C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3894 > C The "polynomial part" of the "standard deviation" of this part of
3895 > C the distribution.
3898 > sig=sig*thet_pred_mean+polthet(j,it)
3900 > C Derivative of the "interior part" of the "standard deviation of the"
3901 > C gamma-dependent Gaussian lobe in t_c.
3902 > sigtc=3*polthet(3,it)
3904 > sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3907 > C Set the parameters of both Gaussian lobes of the distribution.
3908 > C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3909 > fac=sig*sig+sigc0(it)
3912 > C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3913 > sigsqtc=-4.0D0*sigcsq*sigtc
3914 > c print *,i,sig,sigtc,sigsqtc
3915 > C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3916 > sigtc=-sigtc/(fac*fac)
3917 > C Following variable is sigma(t_c)**(-2)
3918 > sigcsq=sigcsq*sigcsq
3920 > sig0inv=1.0D0/sig0i**2
3921 > delthec=thetai-thet_pred_mean
3922 > delthe0=thetai-theta0i
3923 > term1=-0.5D0*sigcsq*delthec*delthec
3924 > term2=-0.5D0*sig0inv*delthe0*delthe0
3925 > C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3926 > C NaNs in taking the logarithm. We extract the largest exponent which is added
3927 > C to the energy (this being the log of the distribution) at the end of energy
3928 > C term evaluation for this virtual-bond angle.
3929 > if (term1.gt.term2) then
3931 > term2=dexp(term2-termm)
3935 > term1=dexp(term1-termm)
3938 > C The ratio between the gamma-independent and gamma-dependent lobes of
3939 > C the distribution is a Gaussian function of thet_pred_mean too.
3940 > diffak=gthet(2,it)-thet_pred_mean
3941 > ratak=diffak/gthet(3,it)**2
3942 > ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3943 > C Let's differentiate it in thet_pred_mean NOW.
3945 > C Now put together the distribution terms to make complete distribution.
3946 > termexp=term1+ak*term2
3947 > termpre=sigc+ak*sig0i
3948 > C Contribution of the bending energy from this theta is just the -log of
3949 > C the sum of the contributions from the two lobes and the pre-exponential
3950 > C factor. Simple enough, isn't it?
3951 > ethetai=(-dlog(termexp)-termm+dlog(termpre))
3952 > C NOW the derivatives!!!
3953 > C 6/6/97 Take into account the deformation.
3954 > E_theta=(delthec*sigcsq*term1
3955 > & +ak*delthe0*sig0inv*term2)/termexp
3956 > E_tc=((sigtc+aktc*sig0i)/termpre
3957 > & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3958 > & aktc*term2)/termexp)
3961 > c-----------------------------------------------------------------------------
3962 > subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3963 > implicit real*8 (a-h,o-z)
3964 > include 'DIMENSIONS'
3965 > include 'COMMON.LOCAL'
3966 > include 'COMMON.IOUNITS'
3967 > common /calcthet/ term1,term2,termm,diffak,ratak,
3968 > & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3969 > & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3970 > delthec=thetai-thet_pred_mean
3971 > delthe0=thetai-theta0i
3972 > C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3973 > t3 = thetai-thet_pred_mean
3977 > t14 = t12+t6*sigsqtc
3979 > t21 = thetai-theta0i
3985 > E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3986 > & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3987 > & *(-t12*t9-ak*sig0inv*t27)
3991 > C--------------------------------------------------------------------------
3992 > subroutine ebend(etheta)
3994 > C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3995 > C angles gamma and its derivatives in consecutive thetas and gammas.
3996 > C ab initio-derived potentials from
3997 > c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3999 > implicit real*8 (a-h,o-z)
4000 > include 'DIMENSIONS'
4001 > include 'COMMON.LOCAL'
4002 > include 'COMMON.GEO'
4003 > include 'COMMON.INTERACT'
4004 > include 'COMMON.DERIV'
4005 > include 'COMMON.VAR'
4006 > include 'COMMON.CHAIN'
4007 > include 'COMMON.IOUNITS'
4008 > include 'COMMON.NAMES'
4009 > include 'COMMON.FFIELD'
4010 > include 'COMMON.CONTROL'
4011 > double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4012 > & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4013 > & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4014 > & sinph1ph2(maxdouble,maxdouble)
4015 > logical lprn /.false./, lprn1 /.false./
4017 > do i=ithet_start,ithet_end
4021 > theti2=0.5d0*theta(i)
4022 > ityp2=ithetyp(itype(i-1))
4024 > coskt(k)=dcos(k*theti2)
4025 > sinkt(k)=dsin(k*theti2)
4030 > if (phii.ne.phii) phii=150.0
4034 > ityp1=ithetyp(itype(i-2))
4036 > cosph1(k)=dcos(k*phii)
4037 > sinph1(k)=dsin(k*phii)
4047 > if (i.lt.nres) then
4050 > if (phii1.ne.phii1) phii1=150.0
4051 > phii1=pinorm(phii1)
4055 > ityp3=ithetyp(itype(i))
4057 > cosph2(k)=dcos(k*phii1)
4058 > sinph2(k)=dsin(k*phii1)
4068 > ethetai=aa0thet(ityp1,ityp2,ityp3)
4071 > ccl=cosph1(l)*cosph2(k-l)
4072 > ssl=sinph1(l)*sinph2(k-l)
4073 > scl=sinph1(l)*cosph2(k-l)
4074 > csl=cosph1(l)*sinph2(k-l)
4075 > cosph1ph2(l,k)=ccl-ssl
4076 > cosph1ph2(k,l)=ccl+ssl
4077 > sinph1ph2(l,k)=scl+csl
4078 > sinph1ph2(k,l)=scl-csl
4082 > write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4083 > & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4084 > write (iout,*) "coskt and sinkt"
4086 > write (iout,*) k,coskt(k),sinkt(k)
4090 > ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4091 > dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4094 > & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4095 > & " ethetai",ethetai
4098 > write (iout,*) "cosph and sinph"
4100 > write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4102 > write (iout,*) "cosph1ph2 and sinph2ph2"
4105 > write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4106 > & sinph1ph2(l,k),sinph1ph2(k,l)
4109 > write(iout,*) "ethetai",ethetai
4113 > aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4114 > & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4115 > & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4116 > & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4117 > ethetai=ethetai+sinkt(m)*aux
4118 > dethetai=dethetai+0.5d0*m*aux*coskt(m)
4119 > dephii=dephii+k*sinkt(m)*(
4120 > & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4121 > & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4122 > dephii1=dephii1+k*sinkt(m)*(
4123 > & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4124 > & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4126 > & write (iout,*) "m",m," k",k," bbthet",
4127 > & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4128 > & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4129 > & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4130 > & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4134 > & write(iout,*) "ethetai",ethetai
4138 > aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4139 > & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4140 > & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4141 > & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4142 > ethetai=ethetai+sinkt(m)*aux
4143 > dethetai=dethetai+0.5d0*m*coskt(m)*aux
4144 > dephii=dephii+l*sinkt(m)*(
4145 > & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4146 > & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4147 > & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4148 > & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4149 > dephii1=dephii1+(k-l)*sinkt(m)*(
4150 > & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4151 > & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4152 > & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4153 > & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4155 > write (iout,*) "m",m," k",k," l",l," ffthet",
4156 > & ffthet(l,k,m,ityp1,ityp2,ityp3),
4157 > & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4158 > & ggthet(l,k,m,ityp1,ityp2,ityp3),
4159 > & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4160 > write (iout,*) cosph1ph2(l,k)*sinkt(m),
4161 > & cosph1ph2(k,l)*sinkt(m),
4162 > & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4168 > if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4169 > & i,theta(i)*rad2deg,phii*rad2deg,
4170 > & phii1*rad2deg,ethetai
4171 > etheta=etheta+ethetai
4172 > if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4173 > if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4174 > gloc(nphi+i-2,icg)=wang*dethetai
4180 > c-----------------------------------------------------------------------------
4181 > subroutine esc(escloc)
4182 > C Calculate the local energy of a side chain and its derivatives in the
4183 > C corresponding virtual-bond valence angles THETA and the spherical angles
4184 > C ALPHA and OMEGA.
4185 > implicit real*8 (a-h,o-z)
4186 > include 'DIMENSIONS'
4187 > include 'COMMON.GEO'
4188 > include 'COMMON.LOCAL'
4189 > include 'COMMON.VAR'
4190 > include 'COMMON.INTERACT'
4191 > include 'COMMON.DERIV'
4192 > include 'COMMON.CHAIN'
4193 > include 'COMMON.IOUNITS'
4194 > include 'COMMON.NAMES'
4195 > include 'COMMON.FFIELD'
4196 > include 'COMMON.CONTROL'
4197 > double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4198 > & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4199 > common /sccalc/ time11,time12,time112,theti,it,nlobit
4202 > c write (iout,'(a)') 'ESC'
4203 > do i=loc_start,loc_end
4205 > if (it.eq.10) goto 1
4207 > c print *,'i=',i,' it=',it,' nlobit=',nlobit
4208 > c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4209 > theti=theta(i+1)-pipol
4214 > if (x(2).gt.pi-delta) then
4218 > call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4220 > call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4221 > call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4222 > & escloci,dersc(2))
4223 > call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4224 > & ddersc0(1),dersc(1))
4225 > call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4226 > & ddersc0(3),dersc(3))
4228 > call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4230 > call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4231 > call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4232 > & dersc0(2),esclocbi,dersc02)
4233 > call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4234 > & dersc12,dersc01)
4235 > call splinthet(x(2),0.5d0*delta,ss,ssd)
4240 > dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4242 > dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4243 > c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4244 > c & esclocbi,ss,ssd
4245 > escloci=ss*escloci+(1.0d0-ss)*esclocbi
4246 > c escloci=esclocbi
4247 > c write (iout,*) escloci
4248 > else if (x(2).lt.delta) then
4252 > call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4254 > call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4255 > call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4256 > & escloci,dersc(2))
4257 > call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4258 > & ddersc0(1),dersc(1))
4259 > call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4260 > & ddersc0(3),dersc(3))
4262 > call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4264 > call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4265 > call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4266 > & dersc0(2),esclocbi,dersc02)
4267 > call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4268 > & dersc12,dersc01)
4272 > call splinthet(x(2),0.5d0*delta,ss,ssd)
4274 > dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4276 > dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4277 > c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4278 > c & esclocbi,ss,ssd
4279 > escloci=ss*escloci+(1.0d0-ss)*esclocbi
4280 > c write (iout,*) escloci
4282 > call enesc(x,escloci,dersc,ddummy,.false.)
4285 > escloc=escloc+escloci
4286 > if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4287 > & 'escloc',i,escloci
4288 > c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4290 > gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4292 > gloc(ialph(i,1),icg)=wscloc*dersc(2)
4293 > gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4298 > C---------------------------------------------------------------------------
4299 > subroutine enesc(x,escloci,dersc,ddersc,mixed)
4300 > implicit real*8 (a-h,o-z)
4301 > include 'DIMENSIONS'
4302 > include 'COMMON.GEO'
4303 > include 'COMMON.LOCAL'
4304 > include 'COMMON.IOUNITS'
4305 > common /sccalc/ time11,time12,time112,theti,it,nlobit
4306 > double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4307 > double precision contr(maxlob,-1:1)
4309 > c write (iout,*) 'it=',it,' nlobit=',nlobit
4313 > if (mixed) ddersc(j)=0.0d0
4317 > C Because of periodicity of the dependence of the SC energy in omega we have
4318 > C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4319 > C To avoid underflows, first compute & store the exponents.
4327 > z(k)=x(k)-censc(k,j,it)
4332 > Axk=Axk+gaussc(l,k,j,it)*z(l)
4338 > expfac=expfac+Ax(k,j,iii)*z(k)
4340 > contr(j,iii)=expfac
4346 > C As in the case of ebend, we want to avoid underflows in exponentiation and
4347 > C subsequent NaNs and INFs in energy calculation.
4348 > C Find the largest exponent
4352 > if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4356 > cd print *,'it=',it,' emin=',emin
4358 > C Compute the contribution to SC energy and derivatives
4363 > adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
4364 > if(adexp.ne.adexp) adexp=1.0
4365 > expfac=dexp(adexp)
4367 > expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4369 > cd print *,'j=',j,' expfac=',expfac
4370 > escloc_i=escloc_i+expfac
4372 > dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4376 > ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4377 > & +gaussc(k,2,j,it))*expfac
4384 > dersc(1)=dersc(1)/cos(theti)**2
4385 > ddersc(1)=ddersc(1)/cos(theti)**2
4386 > ddersc(3)=ddersc(3)
4388 > escloci=-(dlog(escloc_i)-emin)
4390 > dersc(j)=dersc(j)/escloc_i
4394 > ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4399 > C------------------------------------------------------------------------------
4400 > subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4401 > implicit real*8 (a-h,o-z)
4402 > include 'DIMENSIONS'
4403 > include 'COMMON.GEO'
4404 > include 'COMMON.LOCAL'
4405 > include 'COMMON.IOUNITS'
4406 > common /sccalc/ time11,time12,time112,theti,it,nlobit
4407 > double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4408 > double precision contr(maxlob)
4419 > z(k)=x(k)-censc(k,j,it)
4425 > Axk=Axk+gaussc(l,k,j,it)*z(l)
4431 > expfac=expfac+Ax(k,j)*z(k)
4436 > C As in the case of ebend, we want to avoid underflows in exponentiation and
4437 > C subsequent NaNs and INFs in energy calculation.
4438 > C Find the largest exponent
4441 > if (emin.gt.contr(j)) emin=contr(j)
4445 > C Compute the contribution to SC energy and derivatives
4449 > expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4450 > escloc_i=escloc_i+expfac
4452 > dersc(k)=dersc(k)+Ax(k,j)*expfac
4454 > if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4455 > & +gaussc(1,2,j,it))*expfac
4459 > dersc(1)=dersc(1)/cos(theti)**2
4460 > dersc12=dersc12/cos(theti)**2
4461 > escloci=-(dlog(escloc_i)-emin)
4463 > dersc(j)=dersc(j)/escloc_i
4465 > if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4469 > c----------------------------------------------------------------------------------
4470 > subroutine esc(escloc)
4471 > C Calculate the local energy of a side chain and its derivatives in the
4472 > C corresponding virtual-bond valence angles THETA and the spherical angles
4473 > C ALPHA and OMEGA derived from AM1 all-atom calculations.
4474 > C added by Urszula Kozlowska. 07/11/2007
4476 > implicit real*8 (a-h,o-z)
4477 > include 'DIMENSIONS'
4478 > include 'COMMON.GEO'
4479 > include 'COMMON.LOCAL'
4480 > include 'COMMON.VAR'
4481 > include 'COMMON.SCROT'
4482 > include 'COMMON.INTERACT'
4483 > include 'COMMON.DERIV'
4484 > include 'COMMON.CHAIN'
4485 > include 'COMMON.IOUNITS'
4486 > include 'COMMON.NAMES'
4487 > include 'COMMON.FFIELD'
4488 > include 'COMMON.CONTROL'
4489 > include 'COMMON.VECTORS'
4490 > double precision x_prime(3),y_prime(3),z_prime(3)
4491 > & , sumene,dsc_i,dp2_i,x(65),
4492 > & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4493 > & de_dxx,de_dyy,de_dzz,de_dt
4494 > double precision s1_t,s1_6_t,s2_t,s2_6_t
4496 > & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4497 > & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4498 > & dt_dCi(3),dt_dCi1(3)
4499 > common /sccalc/ time11,time12,time112,theti,it,nlobit
4502 > do i=loc_start,loc_end
4503 > costtab(i+1) =dcos(theta(i+1))
4504 > sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4505 > cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4506 > sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4507 > cosfac2=0.5d0/(1.0d0+costtab(i+1))
4508 > cosfac=dsqrt(cosfac2)
4509 > sinfac2=0.5d0/(1.0d0-costtab(i+1))
4510 > sinfac=dsqrt(sinfac2)
4512 > if (it.eq.10) goto 1
4514 > C Compute the axes of tghe local cartesian coordinates system; store in
4515 > c x_prime, y_prime and z_prime
4522 > C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4523 > C & dc_norm(3,i+nres)
4525 > x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4526 > y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4529 > z_prime(j) = -uz(j,i-1)
4531 > c write (2,*) "i",i
4532 > c write (2,*) "x_prime",(x_prime(j),j=1,3)
4533 > c write (2,*) "y_prime",(y_prime(j),j=1,3)
4534 > c write (2,*) "z_prime",(z_prime(j),j=1,3)
4535 > c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4536 > c & " xy",scalar(x_prime(1),y_prime(1)),
4537 > c & " xz",scalar(x_prime(1),z_prime(1)),
4538 > c & " yy",scalar(y_prime(1),y_prime(1)),
4539 > c & " yz",scalar(y_prime(1),z_prime(1)),
4540 > c & " zz",scalar(z_prime(1),z_prime(1))
4542 > C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4543 > C to local coordinate system. Store in xx, yy, zz.
4549 > xx = xx + x_prime(j)*dc_norm(j,i+nres)
4550 > yy = yy + y_prime(j)*dc_norm(j,i+nres)
4551 > zz = zz + z_prime(j)*dc_norm(j,i+nres)
4558 > C Compute the energy of the ith side cbain
4560 > c write (2,*) "xx",xx," yy",yy," zz",zz
4563 > x(j) = sc_parmin(j,it)
4565 > #ifdef CHECK_COORD
4566 > Cc diagnostics - remove later
4567 > xx1 = dcos(alph(2))
4568 > yy1 = dsin(alph(2))*dcos(omeg(2))
4569 > zz1 = -dsin(alph(2))*dsin(omeg(2))
4570 > write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4571 > & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4573 > C," --- ", xx_w,yy_w,zz_w
4576 > sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4577 > & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4579 > sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4580 > & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4582 > sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4583 > & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4584 > & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4585 > & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4586 > & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4588 > sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4589 > & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4590 > & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4591 > & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4592 > & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4594 > dsc_i = 0.743d0+x(61)
4595 > dp2_i = 1.9d0+x(62)
4596 > dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4597 > & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4598 > dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4599 > & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4600 > s1=(1+x(63))/(0.1d0 + dscp1)
4601 > s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4602 > s2=(1+x(65))/(0.1d0 + dscp2)
4603 > s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4604 > sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4605 > & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4606 > c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4608 > c & dscp1,dscp2,sumene
4609 > c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4610 > escloc = escloc + sumene
4611 > c write (2,*) "i",i," escloc",sumene,escloc
4614 > C This section to check the numerical derivatives of the energy of ith side
4615 > C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4616 > C #define DEBUG in the code to turn it on.
4618 > write (2,*) "sumene =",sumene
4622 > write (2,*) xx,yy,zz
4623 > sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4624 > de_dxx_num=(sumenep-sumene)/aincr
4626 > write (2,*) "xx+ sumene from enesc=",sumenep
4629 > write (2,*) xx,yy,zz
4630 > sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4631 > de_dyy_num=(sumenep-sumene)/aincr
4633 > write (2,*) "yy+ sumene from enesc=",sumenep
4636 > write (2,*) xx,yy,zz
4637 > sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4638 > de_dzz_num=(sumenep-sumene)/aincr
4640 > write (2,*) "zz+ sumene from enesc=",sumenep
4641 > costsave=cost2tab(i+1)
4642 > sintsave=sint2tab(i+1)
4643 > cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4644 > sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4645 > sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4646 > de_dt_num=(sumenep-sumene)/aincr
4647 > write (2,*) " t+ sumene from enesc=",sumenep
4648 > cost2tab(i+1)=costsave
4649 > sint2tab(i+1)=sintsave
4650 > C End of diagnostics section.
4653 > C Compute the gradient of esc
4655 > pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4656 > pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4657 > pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4658 > pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4659 > pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4660 > pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4661 > pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4662 > pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4663 > pom1=(sumene3*sint2tab(i+1)+sumene1)
4664 > & *(pom_s1/dscp1+pom_s16*dscp1**4)
4665 > pom2=(sumene4*cost2tab(i+1)+sumene2)
4666 > & *(pom_s2/dscp2+pom_s26*dscp2**4)
4667 > sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4668 > sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4669 > & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4671 > sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4672 > sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4673 > & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4675 > de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4676 > & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4677 > & +(pom1+pom2)*pom_dx
4679 > write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4682 > sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4683 > sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4684 > & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4686 > sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4687 > sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4688 > & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4689 > & +x(59)*zz**2 +x(60)*xx*zz
4690 > de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4691 > & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4692 > & +(pom1-pom2)*pom_dy
4694 > write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4697 > de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4698 > & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4699 > & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4700 > & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4701 > & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4702 > & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4703 > & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4704 > & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4706 > write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4709 > de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4710 > & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4711 > & +pom1*pom_dt1+pom2*pom_dt2
4713 > write(2,*), "de_dt = ", de_dt,de_dt_num
4717 > cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4718 > cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4719 > cosfac2xx=cosfac2*xx
4720 > sinfac2yy=sinfac2*yy
4722 > dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4724 > dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4726 > pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4727 > pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4728 > c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4729 > c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4730 > c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4731 > c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4732 > dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4733 > dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4734 > dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4735 > dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4739 > dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4740 > dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4743 > dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4744 > dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4745 > dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4747 > dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4748 > dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4752 > dXX_Ctab(k,i)=dXX_Ci(k)
4753 > dXX_C1tab(k,i)=dXX_Ci1(k)
4754 > dYY_Ctab(k,i)=dYY_Ci(k)
4755 > dYY_C1tab(k,i)=dYY_Ci1(k)
4756 > dZZ_Ctab(k,i)=dZZ_Ci(k)
4757 > dZZ_C1tab(k,i)=dZZ_Ci1(k)
4758 > dXX_XYZtab(k,i)=dXX_XYZ(k)
4759 > dYY_XYZtab(k,i)=dYY_XYZ(k)
4760 > dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4764 > c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4765 > c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4766 > c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4767 > c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4768 > c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4770 > c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4771 > c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4772 > gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4773 > & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4774 > gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4775 > & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4776 > gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4777 > & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4779 > c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4780 > c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4782 > C to check gradient call subroutine check_grad
4788 > c------------------------------------------------------------------------------
4789 > double precision function enesc(x,xx,yy,zz,cost2,sint2)
4791 > double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
4792 > & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
4793 > sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4794 > & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4796 > sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4797 > & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4799 > sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4800 > & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4801 > & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4802 > & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4803 > & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4805 > sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4806 > & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4807 > & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4808 > & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4809 > & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4811 > dsc_i = 0.743d0+x(61)
4812 > dp2_i = 1.9d0+x(62)
4813 > dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4814 > & *(xx*cost2+yy*sint2))
4815 > dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4816 > & *(xx*cost2-yy*sint2))
4817 > s1=(1+x(63))/(0.1d0 + dscp1)
4818 > s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4819 > s2=(1+x(65))/(0.1d0 + dscp2)
4820 > s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4821 > sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
4822 > & + (sumene4*cost2 +sumene2)*(s2+s2_6)
4827 > c------------------------------------------------------------------------------
4828 > subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4830 > C This procedure calculates two-body contact function g(rij) and its derivative:
4833 > C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4836 > C where x=(rij-r0ij)/delta
4838 > C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4841 > double precision rij,r0ij,eps0ij,fcont,fprimcont
4842 > double precision x,x2,x4,delta
4843 > c delta=0.02D0*r0ij
4844 > c delta=0.2D0*r0ij
4845 > x=(rij-r0ij)/delta
4846 > if (x.lt.-1.0D0) then
4849 > else if (x.le.1.0D0) then
4852 > fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4853 > fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4860 > c------------------------------------------------------------------------------
4861 > subroutine splinthet(theti,delta,ss,ssder)
4862 > implicit real*8 (a-h,o-z)
4863 > include 'DIMENSIONS'
4864 > include 'COMMON.VAR'
4865 > include 'COMMON.GEO'
4868 > if (theti.gt.pipol) then
4869 > call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4871 > call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4876 > c------------------------------------------------------------------------------
4877 > subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4879 > double precision x,x0,delta,f0,f1,fprim0,f,fprim
4880 > double precision ksi,ksi2,ksi3,a1,a2,a3
4881 > a1=fprim0*delta/(f1-f0)
4887 > f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4888 > fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4891 > c------------------------------------------------------------------------------
4892 > subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4894 > double precision x,x0,delta,f0x,f1x,fprim0x,fx
4895 > double precision ksi,ksi2,ksi3,a1,a2,a3
4900 > a2=3*(f1x-f0x)-2*fprim0x*delta
4901 > a3=fprim0x*delta-2*(f1x-f0x)
4902 > fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4905 > C-----------------------------------------------------------------------------
4907 > C-----------------------------------------------------------------------------
4908 > subroutine etor(etors,edihcnstr)
4909 > implicit real*8 (a-h,o-z)
4910 > include 'DIMENSIONS'
4911 > include 'COMMON.VAR'
4912 > include 'COMMON.GEO'
4913 > include 'COMMON.LOCAL'
4914 > include 'COMMON.TORSION'
4915 > include 'COMMON.INTERACT'
4916 > include 'COMMON.DERIV'
4917 > include 'COMMON.CHAIN'
4918 > include 'COMMON.NAMES'
4919 > include 'COMMON.IOUNITS'
4920 > include 'COMMON.FFIELD'
4921 > include 'COMMON.TORCNSTR'
4922 > include 'COMMON.CONTROL'
4924 > C Set lprn=.true. for debugging
4928 > do i=iphi_start,iphi_end
4930 > itori=itortyp(itype(i-2))
4931 > itori1=itortyp(itype(i-1))
4934 > C Proline-Proline pair is a special case...
4935 > if (itori.eq.3 .and. itori1.eq.3) then
4936 > if (phii.gt.-dwapi3) then
4937 > cosphi=dcos(3*phii)
4938 > fac=1.0D0/(1.0D0-cosphi)
4939 > etorsi=v1(1,3,3)*fac
4940 > etorsi=etorsi+etorsi
4941 > etors=etors+etorsi-v1(1,3,3)
4942 > if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
4943 > gloci=gloci-3*fac*etorsi*dsin(3*phii)
4946 > v1ij=v1(j+1,itori,itori1)
4947 > v2ij=v2(j+1,itori,itori1)
4948 > cosphi=dcos(j*phii)
4949 > sinphi=dsin(j*phii)
4950 > etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4951 > if (energy_dec) etors_ii=etors_ii+
4952 > & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4953 > gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4957 > v1ij=v1(j,itori,itori1)
4958 > v2ij=v2(j,itori,itori1)
4959 > cosphi=dcos(j*phii)
4960 > sinphi=dsin(j*phii)
4961 > etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4962 > if (energy_dec) etors_ii=etors_ii+
4963 > & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4964 > gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4967 > if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4970 > & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4971 > & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4972 > & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4973 > gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
4974 > c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4976 > ! 6/20/98 - dihedral angle constraints
4978 > do i=1,ndih_constr
4979 > itori=idih_constr(i)
4982 > if (difi.gt.drange(i)) then
4983 > difi=difi-drange(i)
4984 > edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4985 > gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4986 > else if (difi.lt.-drange(i)) then
4987 > difi=difi+drange(i)
4988 > edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4989 > gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4991 > ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4992 > ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4994 > ! write (iout,*) 'edihcnstr',edihcnstr
4997 > c------------------------------------------------------------------------------
4998 > subroutine etor_d(etors_d)
5002 > c----------------------------------------------------------------------------
5004 > subroutine etor(etors,edihcnstr)
5005 > implicit real*8 (a-h,o-z)
5006 > include 'DIMENSIONS'
5007 > include 'COMMON.VAR'
5008 > include 'COMMON.GEO'
5009 > include 'COMMON.LOCAL'
5010 > include 'COMMON.TORSION'
5011 > include 'COMMON.INTERACT'
5012 > include 'COMMON.DERIV'
5013 > include 'COMMON.CHAIN'
5014 > include 'COMMON.NAMES'
5015 > include 'COMMON.IOUNITS'
5016 > include 'COMMON.FFIELD'
5017 > include 'COMMON.TORCNSTR'
5018 > include 'COMMON.CONTROL'
5020 > C Set lprn=.true. for debugging
5024 > do i=iphi_start,iphi_end
5026 > itori=itortyp(itype(i-2))
5027 > itori1=itortyp(itype(i-1))
5030 > C Regular cosine and sine terms
5031 > do j=1,nterm(itori,itori1)
5032 > v1ij=v1(j,itori,itori1)
5033 > v2ij=v2(j,itori,itori1)
5034 > cosphi=dcos(j*phii)
5035 > sinphi=dsin(j*phii)
5036 > etors=etors+v1ij*cosphi+v2ij*sinphi
5037 > if (energy_dec) etors_ii=etors_ii+
5038 > & v1ij*cosphi+v2ij*sinphi
5039 > gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5043 > C E = SUM ----------------------------------- - v1
5044 > C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5046 > cosphi=dcos(0.5d0*phii)
5047 > sinphi=dsin(0.5d0*phii)
5048 > do j=1,nlor(itori,itori1)
5049 > vl1ij=vlor1(j,itori,itori1)
5050 > vl2ij=vlor2(j,itori,itori1)
5051 > vl3ij=vlor3(j,itori,itori1)
5052 > pom=vl2ij*cosphi+vl3ij*sinphi
5053 > pom1=1.0d0/(pom*pom+1.0d0)
5054 > etors=etors+vl1ij*pom1
5055 > if (energy_dec) etors_ii=etors_ii+
5057 > pom=-pom*pom1*pom1
5058 > gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5060 > C Subtract the constant term
5061 > etors=etors-v0(itori,itori1)
5062 > if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5063 > & 'etor',i,etors_ii-v0(itori,itori1)
5065 > & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5066 > & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5067 > & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5068 > gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5069 > c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5071 > ! 6/20/98 - dihedral angle constraints
5073 > c do i=1,ndih_constr
5074 > do i=idihconstr_start,idihconstr_end
5075 > itori=idih_constr(i)
5077 > difi=pinorm(phii-phi0(i))
5078 > if (difi.gt.drange(i)) then
5079 > difi=difi-drange(i)
5080 > edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5081 > gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5082 > else if (difi.lt.-drange(i)) then
5083 > difi=difi+drange(i)
5084 > edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5085 > gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5089 > cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5090 > cd & rad2deg*phi0(i), rad2deg*drange(i),
5091 > cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5093 > cd write (iout,*) 'edihcnstr',edihcnstr
5096 > c----------------------------------------------------------------------------
5097 > subroutine etor_d(etors_d)
5098 > C 6/23/01 Compute double torsional energy
5099 > implicit real*8 (a-h,o-z)
5100 > include 'DIMENSIONS'
5101 > include 'COMMON.VAR'
5102 > include 'COMMON.GEO'
5103 > include 'COMMON.LOCAL'
5104 > include 'COMMON.TORSION'
5105 > include 'COMMON.INTERACT'
5106 > include 'COMMON.DERIV'
5107 > include 'COMMON.CHAIN'
5108 > include 'COMMON.NAMES'
5109 > include 'COMMON.IOUNITS'
5110 > include 'COMMON.FFIELD'
5111 > include 'COMMON.TORCNSTR'
5113 > C Set lprn=.true. for debugging
5117 > do i=iphid_start,iphid_end
5118 > itori=itortyp(itype(i-2))
5119 > itori1=itortyp(itype(i-1))
5120 > itori2=itortyp(itype(i))
5125 > C Regular cosine and sine terms
5126 > do j=1,ntermd_1(itori,itori1,itori2)
5127 > v1cij=v1c(1,j,itori,itori1,itori2)
5128 > v1sij=v1s(1,j,itori,itori1,itori2)
5129 > v2cij=v1c(2,j,itori,itori1,itori2)
5130 > v2sij=v1s(2,j,itori,itori1,itori2)
5131 > cosphi1=dcos(j*phii)
5132 > sinphi1=dsin(j*phii)
5133 > cosphi2=dcos(j*phii1)
5134 > sinphi2=dsin(j*phii1)
5135 > etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5136 > & v2cij*cosphi2+v2sij*sinphi2
5137 > gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5138 > gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5140 > do k=2,ntermd_2(itori,itori1,itori2)
5142 > v1cdij = v2c(k,l,itori,itori1,itori2)
5143 > v2cdij = v2c(l,k,itori,itori1,itori2)
5144 > v1sdij = v2s(k,l,itori,itori1,itori2)
5145 > v2sdij = v2s(l,k,itori,itori1,itori2)
5146 > cosphi1p2=dcos(l*phii+(k-l)*phii1)
5147 > cosphi1m2=dcos(l*phii-(k-l)*phii1)
5148 > sinphi1p2=dsin(l*phii+(k-l)*phii1)
5149 > sinphi1m2=dsin(l*phii-(k-l)*phii1)
5150 > etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5151 > & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5152 > gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5153 > & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5154 > gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5155 > & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5158 > gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5159 > gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5164 > c------------------------------------------------------------------------------
5165 > subroutine eback_sc_corr(esccor)
5166 > c 7/21/2007 Correlations between the backbone-local and side-chain-local
5167 > c conformational states; temporarily implemented as differences
5168 > c between UNRES torsional potentials (dependent on three types of
5169 > c residues) and the torsional potentials dependent on all 20 types
5170 > c of residues computed from AM1 energy surfaces of terminally-blocked
5171 > c amino-acid residues.
5172 > implicit real*8 (a-h,o-z)
5173 > include 'DIMENSIONS'
5174 > include 'COMMON.VAR'
5175 > include 'COMMON.GEO'
5176 > include 'COMMON.LOCAL'
5177 > include 'COMMON.TORSION'
5178 > include 'COMMON.SCCOR'
5179 > include 'COMMON.INTERACT'
5180 > include 'COMMON.DERIV'
5181 > include 'COMMON.CHAIN'
5182 > include 'COMMON.NAMES'
5183 > include 'COMMON.IOUNITS'
5184 > include 'COMMON.FFIELD'
5185 > include 'COMMON.CONTROL'
5187 > C Set lprn=.true. for debugging
5190 > c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5192 > do i=iphi_start,iphi_end
5198 > do j=1,nterm_sccor
5199 > v1ij=v1sccor(j,itori,itori1)
5200 > v2ij=v2sccor(j,itori,itori1)
5201 > cosphi=dcos(j*phii)
5202 > sinphi=dsin(j*phii)
5203 > esccor=esccor+v1ij*cosphi+v2ij*sinphi
5204 > gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5207 > & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5208 > & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5209 > & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5210 > gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5214 > c----------------------------------------------------------------------------
5215 > subroutine multibody(ecorr)
5216 > C This subroutine calculates multi-body contributions to energy following
5217 > C the idea of Skolnick et al. If side chains I and J make a contact and
5218 > C at the same time side chains I+1 and J+1 make a contact, an extra
5219 > C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5220 > implicit real*8 (a-h,o-z)
5221 > include 'DIMENSIONS'
5222 > include 'COMMON.IOUNITS'
5223 > include 'COMMON.DERIV'
5224 > include 'COMMON.INTERACT'
5225 > include 'COMMON.CONTACTS'
5226 > double precision gx(3),gx1(3)
5229 > C Set lprn=.true. for debugging
5233 > write (iout,'(a)') 'Contact function values:'
5235 > write (iout,'(i2,20(1x,i2,f10.5))')
5236 > & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5242 > gradcorr(j,i)=0.0D0
5243 > gradxorr(j,i)=0.0D0
5251 > num_conti=num_cont(i)
5252 > num_conti1=num_cont(i1)
5255 > do kk=1,num_conti1
5257 > if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5258 > cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5259 > cd & ' ishift=',ishift
5260 > C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5261 > C The system gains extra energy.
5262 > ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5263 > endif ! j1==j+-ishift
5272 > c------------------------------------------------------------------------------
5273 > double precision function esccorr(i,j,k,l,jj,kk)
5274 > implicit real*8 (a-h,o-z)
5275 > include 'DIMENSIONS'
5276 > include 'COMMON.IOUNITS'
5277 > include 'COMMON.DERIV'
5278 > include 'COMMON.INTERACT'
5279 > include 'COMMON.CONTACTS'
5280 > double precision gx(3),gx1(3)
5285 > cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5286 > C Calculate the multi-body contribution to energy.
5287 > C Calculate multi-body contributions to the gradient.
5288 > cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5289 > cd & k,l,(gacont(m,kk,k),m=1,3)
5291 > gx(m) =ekl*gacont(m,jj,i)
5292 > gx1(m)=eij*gacont(m,kk,k)
5293 > gradxorr(m,i)=gradxorr(m,i)-gx(m)
5294 > gradxorr(m,j)=gradxorr(m,j)+gx(m)
5295 > gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5296 > gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5300 > gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5305 > gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5311 > c------------------------------------------------------------------------------
5313 > subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5314 > implicit real*8 (a-h,o-z)
5315 > include 'DIMENSIONS'
5316 > integer dimen1,dimen2,atom,indx
5317 > double precision buffer(dimen1,dimen2)
5318 > double precision zapas
5319 > common /contacts_hb/ zapas(3,maxconts,maxres,8),
5320 > & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
5321 > & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
5322 > & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
5323 > num_kont=num_cont_hb(atom)
5327 > buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5330 > buffer(i,indx+25)=facont_hb(i,atom)
5331 > buffer(i,indx+26)=ees0p(i,atom)
5332 > buffer(i,indx+27)=ees0m(i,atom)
5333 > buffer(i,indx+28)=d_cont(i,atom)
5334 > buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
5336 > buffer(1,indx+30)=dfloat(num_kont)
5339 > c------------------------------------------------------------------------------
5340 > subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5341 > implicit real*8 (a-h,o-z)
5342 > include 'DIMENSIONS'
5343 > integer dimen1,dimen2,atom,indx
5344 > double precision buffer(dimen1,dimen2)
5345 > double precision zapas
5346 > common /contacts_hb/ zapas(3,maxconts,maxres,8),
5347 > & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
5348 > & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
5349 > & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
5350 > num_kont=buffer(1,indx+30)
5351 > num_kont_old=num_cont_hb(atom)
5352 > num_cont_hb(atom)=num_kont+num_kont_old
5357 > zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5360 > facont_hb(ii,atom)=buffer(i,indx+25)
5361 > ees0p(ii,atom)=buffer(i,indx+26)
5362 > ees0m(ii,atom)=buffer(i,indx+27)
5363 > d_cont(i,atom)=buffer(i,indx+28)
5364 > jcont_hb(ii,atom)=buffer(i,indx+29)
5368 > c------------------------------------------------------------------------------
5370 > subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5371 > C This subroutine calculates multi-body contributions to hydrogen-bonding
5372 > implicit real*8 (a-h,o-z)
5373 > include 'DIMENSIONS'
5374 > include 'COMMON.IOUNITS'
5377 > parameter (max_cont=maxconts)
5378 > parameter (max_dim=2*(8*3+6))
5379 > parameter (msglen1=max_cont*max_dim)
5380 > parameter (msglen2=2*msglen1)
5381 > integer source,CorrelType,CorrelID,Error
5382 > double precision buffer(max_cont,max_dim)
5383 > integer status(MPI_STATUS_SIZE)
5385 > include 'COMMON.SETUP'
5386 > include 'COMMON.FFIELD'
5387 > include 'COMMON.DERIV'
5388 > include 'COMMON.INTERACT'
5389 > include 'COMMON.CONTACTS'
5390 > include 'COMMON.CONTROL'
5391 > double precision gx(3),gx1(3),time00
5392 > logical lprn,ldone
5394 > C Set lprn=.true. for debugging
5399 > if (nfgtasks.le.1) goto 30
5401 > write (iout,'(a)') 'Contact function values:'
5403 > write (iout,'(2i3,50(1x,i2,f5.2))')
5404 > & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5405 > & j=1,num_cont_hb(i))
5408 > C Caution! Following code assumes that electrostatic interactions concerning
5409 > C a given atom are split among at most two processors!
5411 > CorrelID=fg_rank+1
5419 > c write (*,*) 'MyRank',MyRank,' mm',mm
5422 > c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5423 > if (fg_rank.gt.0) then
5424 > C Send correlation contributions to the preceding processor
5426 > nn=num_cont_hb(iatel_s)
5427 > call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5428 > c write (*,*) 'The BUFFER array:'
5430 > c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
5432 > if (ielstart(iatel_s).gt.iatel_s+ispp) then
5434 > call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
5435 > C Clear the contacts of the atom passed to the neighboring processor
5436 > nn=num_cont_hb(iatel_s+1)
5438 > c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
5440 > num_cont_hb(iatel_s)=0
5442 > cd write (iout,*) 'Processor ',fg_rank,MyRank,
5443 > cd & ' is sending correlation contribution to processor',fg_rank-1,
5444 > cd & ' msglen=',msglen
5445 > c write (*,*) 'Processor ',fg_rank,MyRank,
5446 > c & ' is sending correlation contribution to processor',fg_rank-1,
5447 > c & ' msglen=',msglen,' CorrelType=',CorrelType
5448 > time00=MPI_Wtime()
5449 > call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1,
5450 > & CorrelType,FG_COMM,IERROR)
5451 > time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5452 > cd write (iout,*) 'Processor ',fg_rank,
5453 > cd & ' has sent correlation contribution to processor',fg_rank-1,
5454 > cd & ' msglen=',msglen,' CorrelID=',CorrelID
5455 > c write (*,*) 'Processor ',fg_rank,
5456 > c & ' has sent correlation contribution to processor',fg_rank-1,
5457 > c & ' msglen=',msglen,' CorrelID=',CorrelID
5459 > endif ! (fg_rank.gt.0)
5460 > if (ldone) goto 30
5463 > c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5464 > if (fg_rank.lt.nfgtasks-1) then
5465 > C Receive correlation contributions from the next processor
5467 > if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5468 > cd write (iout,*) 'Processor',fg_rank,
5469 > cd & ' is receiving correlation contribution from processor',fg_rank+1,
5470 > cd & ' msglen=',msglen,' CorrelType=',CorrelType
5471 > c write (*,*) 'Processor',fg_rank,
5472 > c &' is receiving correlation contribution from processor',fg_rank+1,
5473 > c & ' msglen=',msglen,' CorrelType=',CorrelType
5474 > time00=MPI_Wtime()
5476 > do while (nbytes.le.0)
5477 > call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5478 > call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
5480 > c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
5481 > call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION,
5482 > & fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5483 > time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5484 > c write (*,*) 'Processor',fg_rank,
5485 > c &' has received correlation contribution from processor',fg_rank+1,
5486 > c & ' msglen=',msglen,' nbytes=',nbytes
5487 > c write (*,*) 'The received BUFFER array:'
5489 > c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
5491 > if (msglen.eq.msglen1) then
5492 > call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5493 > else if (msglen.eq.msglen2) then
5494 > call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5495 > call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer)
5498 > & 'ERROR!!!! message length changed while processing correlations.'
5500 > & 'ERROR!!!! message length changed while processing correlations.'
5501 > call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
5502 > endif ! msglen.eq.msglen1
5503 > endif ! fg_rank.lt.nfgtasks-1
5504 > if (ldone) goto 30
5510 > write (iout,'(a)') 'Contact function values:'
5512 > write (iout,'(2i3,50(1x,i2,f5.2))')
5513 > & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5514 > & j=1,num_cont_hb(i))
5518 > C Remove the loop below after debugging !!!
5521 > gradcorr(j,i)=0.0D0
5522 > gradxorr(j,i)=0.0D0
5525 > C Calculate the local-electrostatic correlation terms
5526 > do i=iatel_s,iatel_e+1
5528 > num_conti=num_cont_hb(i)
5529 > num_conti1=num_cont_hb(i+1)
5532 > do kk=1,num_conti1
5533 > j1=jcont_hb(kk,i1)
5534 > c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5535 > c & ' jj=',jj,' kk=',kk
5536 > if (j1.eq.j+1 .or. j1.eq.j-1) then
5537 > C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5538 > C The system gains extra energy.
5539 > ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5540 > if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5541 > & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5543 > else if (j1.eq.j) then
5544 > C Contacts I-J and I-(J+1) occur simultaneously.
5545 > C The system loses extra energy.
5546 > c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5551 > c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5552 > c & ' jj=',jj,' kk=',kk
5553 > if (j1.eq.j+1) then
5554 > C Contacts I-J and (I+1)-J occur simultaneously.
5555 > C The system loses extra energy.
5556 > c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5563 > c------------------------------------------------------------------------------
5564 > subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5566 > C This subroutine calculates multi-body contributions to hydrogen-bonding
5567 > implicit real*8 (a-h,o-z)
5568 > include 'DIMENSIONS'
5569 > include 'COMMON.IOUNITS'
5572 > parameter (max_cont=maxconts)
5573 > parameter (max_dim=2*(8*3+6))
5574 > c parameter (msglen1=max_cont*max_dim*4)
5575 > parameter (msglen1=max_cont*max_dim/2)
5576 > parameter (msglen2=2*msglen1)
5577 > integer source,CorrelType,CorrelID,Error
5578 > double precision buffer(max_cont,max_dim)
5579 > integer status(MPI_STATUS_SIZE)
5581 > include 'COMMON.SETUP'
5582 > include 'COMMON.FFIELD'
5583 > include 'COMMON.DERIV'
5584 > include 'COMMON.INTERACT'
5585 > include 'COMMON.CONTACTS'
5586 > include 'COMMON.CONTROL'
5587 > double precision gx(3),gx1(3)
5588 > logical lprn,ldone
5589 > C Set lprn=.true. for debugging
5595 > if (fgProcs.le.1) goto 30
5597 > write (iout,'(a)') 'Contact function values:'
5599 > write (iout,'(2i3,50(1x,i2,f5.2))')
5600 > & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5601 > & j=1,num_cont_hb(i))
5604 > C Caution! Following code assumes that electrostatic interactions concerning
5605 > C a given atom are split among at most two processors!
5615 > cd write (iout,*) 'MyRank',MyRank,' mm',mm
5618 > cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5619 > if (MyRank.gt.0) then
5620 > C Send correlation contributions to the preceding processor
5622 > nn=num_cont_hb(iatel_s)
5623 > call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5624 > cd write (iout,*) 'The BUFFER array:'
5626 > cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
5628 > if (ielstart(iatel_s).gt.iatel_s+ispp) then
5630 > call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
5631 > C Clear the contacts of the atom passed to the neighboring processor
5632 > nn=num_cont_hb(iatel_s+1)
5634 > cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
5636 > num_cont_hb(iatel_s)=0
5638 > cd write (*,*) 'Processor ',fg_rank,MyRank,
5639 > cd & ' is sending correlation contribution to processor',fg_rank-1,
5640 > cd & ' msglen=',msglen
5641 > cd write (*,*) 'Processor ',MyID,MyRank,
5642 > cd & ' is sending correlation contribution to processor',fg_rank-1,
5643 > cd & ' msglen=',msglen,' CorrelType=',CorrelType
5644 > time00=MPI_Wtime()
5645 > call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1,
5646 > & CorrelType,FG_COMM,IERROR)
5647 > time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5648 > cd write (*,*) 'Processor ',fg_rank,MyRank,
5649 > cd & ' has sent correlation contribution to processor',fg_rank-1,
5650 > cd & ' msglen=',msglen,' CorrelID=',CorrelID
5651 > cd write (*,*) 'Processor ',fg_rank,
5652 > cd & ' has sent correlation contribution to processor',fg_rank-1,
5653 > cd & ' msglen=',msglen,' CorrelID=',CorrelID
5655 > endif ! (MyRank.gt.0)
5656 > if (ldone) goto 30
5659 > cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5660 > if (fg_rank.lt.nfgtasks-1) then
5661 > C Receive correlation contributions from the next processor
5663 > if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5664 > cd write (iout,*) 'Processor',fg_rank,
5665 > cd & ' is receiving correlation contribution from processor',fg_rank+1,
5666 > cd & ' msglen=',msglen,' CorrelType=',CorrelType
5667 > cd write (*,*) 'Processor',fg_rank,
5668 > cd & ' is receiving correlation contribution from processor',fg_rank+1,
5669 > cd & ' msglen=',msglen,' CorrelType=',CorrelType
5670 > time00=MPI_Wtime()
5672 > do while (nbytes.le.0)
5673 > call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5674 > call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
5676 > cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5677 > call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION,
5678 > & fg_rank+1,CorrelType,status,IERROR)
5679 > time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5680 > cd write (iout,*) 'Processor',fg_rank,
5681 > cd & ' has received correlation contribution from processor',fg_rank+1,
5682 > cd & ' msglen=',msglen,' nbytes=',nbytes
5683 > cd write (iout,*) 'The received BUFFER array:'
5684 > cd do i=1,max_cont
5685 > cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5687 > if (msglen.eq.msglen1) then
5688 > call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5689 > else if (msglen.eq.msglen2) then
5690 > call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5691 > call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer)
5694 > & 'ERROR!!!! message length changed while processing correlations.'
5696 > & 'ERROR!!!! message length changed while processing correlations.'
5697 > call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
5698 > endif ! msglen.eq.msglen1
5699 > endif ! fg_rank.lt.nfgtasks-1
5700 > if (ldone) goto 30
5706 > write (iout,'(a)') 'Contact function values:'
5708 > write (iout,'(2i3,50(1x,i2,f5.2))')
5709 > & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5710 > & j=1,num_cont_hb(i))
5716 > C Remove the loop below after debugging !!!
5719 > gradcorr(j,i)=0.0D0
5720 > gradxorr(j,i)=0.0D0
5723 > C Calculate the dipole-dipole interaction energies
5724 > if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5725 > do i=iatel_s,iatel_e+1
5726 > num_conti=num_cont_hb(i)
5729 > call dipole(i,j,jj)
5733 > C Calculate the local-electrostatic correlation terms
5734 > do i=iatel_s,iatel_e+1
5736 > num_conti=num_cont_hb(i)
5737 > num_conti1=num_cont_hb(i+1)
5740 > do kk=1,num_conti1
5741 > j1=jcont_hb(kk,i1)
5742 > c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5743 > c & ' jj=',jj,' kk=',kk
5744 > if (j1.eq.j+1 .or. j1.eq.j-1) then
5745 > C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5746 > C The system gains extra energy.
5748 > sqd1=dsqrt(d_cont(jj,i))
5749 > sqd2=dsqrt(d_cont(kk,i1))
5750 > sred_geom = sqd1*sqd2
5751 > IF (sred_geom.lt.cutoff_corr) THEN
5752 > call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5753 > & ekont,fprimcont)
5754 > cd write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5755 > cd & ' jj=',jj,' kk=',kk
5756 > fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5757 > fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5759 > g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5760 > g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5763 > cd write (iout,*) 'sred_geom=',sred_geom,
5764 > cd & ' ekont=',ekont,' fprim=',fprimcont
5765 > call calc_eello(i,j,i+1,j1,jj,kk)
5766 > if (wcorr4.gt.0.0d0)
5767 > & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5768 > if (energy_dec.and.wcorr4.gt.0.0d0)
5769 > 1 write (iout,'(a6,2i5,0pf7.3)')
5770 > 2 'ecorr4',i,j,eello4(i,j,i+1,j1,jj,kk)
5771 > if (wcorr5.gt.0.0d0)
5772 > & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5773 > if (energy_dec.and.wcorr5.gt.0.0d0)
5774 > 1 write (iout,'(a6,2i5,0pf7.3)')
5775 > 2 'ecorr5',i,j,eello5(i,j,i+1,j1,jj,kk)
5776 > cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5777 > cd write(2,*)'ijkl',i,j,i+1,j1
5778 > if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5779 > & .or. wturn6.eq.0.0d0))then
5780 > cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5781 > ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5782 > if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5783 > 1 'ecorr6',i,j,eello6(i,j,i+1,j1,jj,kk)
5784 > cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5785 > cd & 'ecorr6=',ecorr6
5786 > cd write (iout,'(4e15.5)') sred_geom,
5787 > cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5788 > cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5789 > cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5790 > else if (wturn6.gt.0.0d0
5791 > & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5792 > cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5793 > eturn6=eturn6+eello_turn6(i,jj,kk)
5794 > if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5795 > 1 'eturn6',i,j,eello_turn6(i,jj,kk)
5796 > cd write (2,*) 'multibody_eello:eturn6',eturn6
5800 > else if (j1.eq.j) then
5801 > C Contacts I-J and I-(J+1) occur simultaneously.
5802 > C The system loses extra energy.
5803 > c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5808 > c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5809 > c & ' jj=',jj,' kk=',kk
5810 > if (j1.eq.j+1) then
5811 > C Contacts I-J and (I+1)-J occur simultaneously.
5812 > C The system loses extra energy.
5813 > c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5820 > c------------------------------------------------------------------------------
5821 > double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5822 > implicit real*8 (a-h,o-z)
5823 > include 'DIMENSIONS'
5824 > include 'COMMON.IOUNITS'
5825 > include 'COMMON.DERIV'
5826 > include 'COMMON.INTERACT'
5827 > include 'COMMON.CONTACTS'
5828 > double precision gx(3),gx1(3)
5831 > eij=facont_hb(jj,i)
5832 > ekl=facont_hb(kk,k)
5833 > ees0pij=ees0p(jj,i)
5834 > ees0pkl=ees0p(kk,k)
5835 > ees0mij=ees0m(jj,i)
5836 > ees0mkl=ees0m(kk,k)
5838 > ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5839 > cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5840 > C Following 4 lines for diagnostics.
5845 > c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5847 > c write (iout,*)'Contacts have occurred for peptide groups',
5848 > c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5849 > c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5850 > C Calculate the multi-body contribution to energy.
5851 > ecorr=ecorr+ekont*ees
5852 > C Calculate multi-body contributions to the gradient.
5854 > ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5855 > gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5856 > & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5857 > & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5858 > gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5859 > & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5860 > & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5861 > ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5862 > gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5863 > & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5864 > & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5865 > gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5866 > & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5867 > & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5871 > gradcorr(ll,m)=gradcorr(ll,m)+
5872 > & ees*ekl*gacont_hbr(ll,jj,i)-
5873 > & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5874 > & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5879 > gradcorr(ll,m)=gradcorr(ll,m)+
5880 > & ees*eij*gacont_hbr(ll,kk,k)-
5881 > & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5882 > & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5888 > C---------------------------------------------------------------------------
5889 > subroutine dipole(i,j,jj)
5890 > implicit real*8 (a-h,o-z)
5891 > include 'DIMENSIONS'
5892 > include 'COMMON.IOUNITS'
5893 > include 'COMMON.CHAIN'
5894 > include 'COMMON.FFIELD'
5895 > include 'COMMON.DERIV'
5896 > include 'COMMON.INTERACT'
5897 > include 'COMMON.CONTACTS'
5898 > include 'COMMON.TORSION'
5899 > include 'COMMON.VAR'
5900 > include 'COMMON.GEO'
5901 > dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5903 > iti1 = itortyp(itype(i+1))
5904 > if (j.lt.nres-1) then
5905 > itj1 = itortyp(itype(j+1))
5910 > dipi(iii,1)=Ub2(iii,i)
5911 > dipderi(iii)=Ub2der(iii,i)
5912 > dipi(iii,2)=b1(iii,iti1)
5913 > dipj(iii,1)=Ub2(iii,j)
5914 > dipderj(iii)=Ub2der(iii,j)
5915 > dipj(iii,2)=b1(iii,itj1)
5919 > call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5922 > dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5929 > call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5933 > dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5938 > call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5939 > call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5941 > dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5943 > call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5945 > dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5949 > C---------------------------------------------------------------------------
5950 > subroutine calc_eello(i,j,k,l,jj,kk)
5952 > C This subroutine computes matrices and vectors needed to calculate
5953 > C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5955 > implicit real*8 (a-h,o-z)
5956 > include 'DIMENSIONS'
5957 > include 'COMMON.IOUNITS'
5958 > include 'COMMON.CHAIN'
5959 > include 'COMMON.DERIV'
5960 > include 'COMMON.INTERACT'
5961 > include 'COMMON.CONTACTS'
5962 > include 'COMMON.TORSION'
5963 > include 'COMMON.VAR'
5964 > include 'COMMON.GEO'
5965 > include 'COMMON.FFIELD'
5966 > double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5967 > & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5969 > common /kutas/ lprn
5970 > cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5971 > cd & ' jj=',jj,' kk=',kk
5972 > cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5975 > aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5976 > aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5979 > call transpose2(aa1(1,1),aa1t(1,1))
5980 > call transpose2(aa2(1,1),aa2t(1,1))
5983 > call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5984 > & aa1tder(1,1,lll,kkk))
5985 > call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5986 > & aa2tder(1,1,lll,kkk))
5989 > if (l.eq.j+1) then
5990 > C parallel orientation of the two CA-CA-CA frames.
5992 > iti=itortyp(itype(i))
5996 > itk1=itortyp(itype(k+1))
5997 > itj=itortyp(itype(j))
5998 > if (l.lt.nres-1) then
5999 > itl1=itortyp(itype(l+1))
6003 > C A1 kernel(j+1) A2T
6005 > cd write (iout,'(3f10.5,5x,3f10.5)')
6006 > cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6008 > call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6009 > & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6010 > & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6011 > C Following matrices are needed only for 6-th order cumulants
6012 > IF (wcorr6.gt.0.0d0) THEN
6013 > call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6014 > & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6015 > & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6016 > call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6017 > & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6018 > & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6019 > & ADtEAderx(1,1,1,1,1,1))
6021 > call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6022 > & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6023 > & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6024 > & ADtEA1derx(1,1,1,1,1,1))
6026 > C End 6-th order cumulants
6029 > cd write (2,*) 'In calc_eello6'
6031 > cd write (2,*) 'iii=',iii
6033 > cd write (2,*) 'kkk=',kkk
6035 > cd write (2,'(3(2f10.5),5x)')
6036 > cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6041 > call transpose2(EUgder(1,1,k),auxmat(1,1))
6042 > call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6043 > call transpose2(EUg(1,1,k),auxmat(1,1))
6044 > call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6045 > call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6049 > call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6050 > & EAEAderx(1,1,lll,kkk,iii,1))
6054 > C A1T kernel(i+1) A2
6055 > call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6056 > & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6057 > & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6058 > C Following matrices are needed only for 6-th order cumulants
6059 > IF (wcorr6.gt.0.0d0) THEN
6060 > call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6061 > & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6062 > & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6063 > call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6064 > & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6065 > & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6066 > & ADtEAderx(1,1,1,1,1,2))
6067 > call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6068 > & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6069 > & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6070 > & ADtEA1derx(1,1,1,1,1,2))
6072 > C End 6-th order cumulants
6073 > call transpose2(EUgder(1,1,l),auxmat(1,1))
6074 > call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6075 > call transpose2(EUg(1,1,l),auxmat(1,1))
6076 > call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6077 > call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6081 > call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6082 > & EAEAderx(1,1,lll,kkk,iii,2))
6087 > C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6088 > C They are needed only when the fifth- or the sixth-order cumulants are
6090 > IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6091 > call transpose2(AEA(1,1,1),auxmat(1,1))
6092 > call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6093 > call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6094 > call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6095 > call transpose2(AEAderg(1,1,1),auxmat(1,1))
6096 > call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6097 > call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6098 > call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6099 > call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6100 > call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6101 > call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6102 > call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6103 > call transpose2(AEA(1,1,2),auxmat(1,1))
6104 > call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6105 > call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6106 > call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6107 > call transpose2(AEAderg(1,1,2),auxmat(1,1))
6108 > call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6109 > call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6110 > call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6111 > call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6112 > call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6113 > call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6114 > call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6115 > C Calculate the Cartesian derivatives of the vectors.
6119 > call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6120 > call matvec2(auxmat(1,1),b1(1,iti),
6121 > & AEAb1derx(1,lll,kkk,iii,1,1))
6122 > call matvec2(auxmat(1,1),Ub2(1,i),
6123 > & AEAb2derx(1,lll,kkk,iii,1,1))
6124 > call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6125 > & AEAb1derx(1,lll,kkk,iii,2,1))
6126 > call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6127 > & AEAb2derx(1,lll,kkk,iii,2,1))
6128 > call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6129 > call matvec2(auxmat(1,1),b1(1,itj),
6130 > & AEAb1derx(1,lll,kkk,iii,1,2))
6131 > call matvec2(auxmat(1,1),Ub2(1,j),
6132 > & AEAb2derx(1,lll,kkk,iii,1,2))
6133 > call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6134 > & AEAb1derx(1,lll,kkk,iii,2,2))
6135 > call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6136 > & AEAb2derx(1,lll,kkk,iii,2,2))
6143 > C Antiparallel orientation of the two CA-CA-CA frames.
6145 > iti=itortyp(itype(i))
6149 > itk1=itortyp(itype(k+1))
6150 > itl=itortyp(itype(l))
6151 > itj=itortyp(itype(j))
6152 > if (j.lt.nres-1) then
6153 > itj1=itortyp(itype(j+1))
6157 > C A2 kernel(j-1)T A1T
6158 > call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6159 > & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6160 > & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6161 > C Following matrices are needed only for 6-th order cumulants
6162 > IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6163 > & j.eq.i+4 .and. l.eq.i+3)) THEN
6164 > call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6165 > & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6166 > & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6167 > call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6168 > & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6169 > & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6170 > & ADtEAderx(1,1,1,1,1,1))
6171 > call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6172 > & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6173 > & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6174 > & ADtEA1derx(1,1,1,1,1,1))
6176 > C End 6-th order cumulants
6177 > call transpose2(EUgder(1,1,k),auxmat(1,1))
6178 > call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6179 > call transpose2(EUg(1,1,k),auxmat(1,1))
6180 > call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6181 > call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6185 > call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6186 > & EAEAderx(1,1,lll,kkk,iii,1))
6190 > C A2T kernel(i+1)T A1
6191 > call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6192 > & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6193 > & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6194 > C Following matrices are needed only for 6-th order cumulants
6195 > IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6196 > & j.eq.i+4 .and. l.eq.i+3)) THEN
6197 > call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6198 > & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6199 > & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6200 > call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6201 > & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6202 > & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6203 > & ADtEAderx(1,1,1,1,1,2))
6204 > call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6205 > & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6206 > & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6207 > & ADtEA1derx(1,1,1,1,1,2))
6209 > C End 6-th order cumulants
6210 > call transpose2(EUgder(1,1,j),auxmat(1,1))
6211 > call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6212 > call transpose2(EUg(1,1,j),auxmat(1,1))
6213 > call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6214 > call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6218 > call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6219 > & EAEAderx(1,1,lll,kkk,iii,2))
6224 > C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6225 > C They are needed only when the fifth- or the sixth-order cumulants are
6227 > IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6228 > & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6229 > call transpose2(AEA(1,1,1),auxmat(1,1))
6230 > call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6231 > call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6232 > call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6233 > call transpose2(AEAderg(1,1,1),auxmat(1,1))
6234 > call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6235 > call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6236 > call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6237 > call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6238 > call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6239 > call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6240 > call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6241 > call transpose2(AEA(1,1,2),auxmat(1,1))
6242 > call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6243 > call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6244 > call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6245 > call transpose2(AEAderg(1,1,2),auxmat(1,1))
6246 > call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6247 > call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6248 > call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6249 > call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6250 > call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6251 > call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6252 > call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6253 > C Calculate the Cartesian derivatives of the vectors.
6257 > call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6258 > call matvec2(auxmat(1,1),b1(1,iti),
6259 > & AEAb1derx(1,lll,kkk,iii,1,1))
6260 > call matvec2(auxmat(1,1),Ub2(1,i),
6261 > & AEAb2derx(1,lll,kkk,iii,1,1))
6262 > call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6263 > & AEAb1derx(1,lll,kkk,iii,2,1))
6264 > call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6265 > & AEAb2derx(1,lll,kkk,iii,2,1))
6266 > call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6267 > call matvec2(auxmat(1,1),b1(1,itl),
6268 > & AEAb1derx(1,lll,kkk,iii,1,2))
6269 > call matvec2(auxmat(1,1),Ub2(1,l),
6270 > & AEAb2derx(1,lll,kkk,iii,1,2))
6271 > call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6272 > & AEAb1derx(1,lll,kkk,iii,2,2))
6273 > call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6274 > & AEAb2derx(1,lll,kkk,iii,2,2))
6283 > C---------------------------------------------------------------------------
6284 > subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6285 > & KK,KKderg,AKA,AKAderg,AKAderx)
6289 > double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6290 > & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6291 > & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6292 > integer iii,kkk,lll
6295 > common /kutas/ lprn
6296 > call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6298 > call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6299 > & AKAderg(1,1,iii))
6301 > cd if (lprn) write (2,*) 'In kernel'
6303 > cd if (lprn) write (2,*) 'kkk=',kkk
6305 > call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6306 > & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6308 > cd write (2,*) 'lll=',lll
6309 > cd write (2,*) 'iii=1'
6311 > cd write (2,'(3(2f10.5),5x)')
6312 > cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6315 > call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6316 > & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6318 > cd write (2,*) 'lll=',lll
6319 > cd write (2,*) 'iii=2'
6321 > cd write (2,'(3(2f10.5),5x)')
6322 > cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6329 > C---------------------------------------------------------------------------
6330 > double precision function eello4(i,j,k,l,jj,kk)
6331 > implicit real*8 (a-h,o-z)
6332 > include 'DIMENSIONS'
6333 > include 'COMMON.IOUNITS'
6334 > include 'COMMON.CHAIN'
6335 > include 'COMMON.DERIV'
6336 > include 'COMMON.INTERACT'
6337 > include 'COMMON.CONTACTS'
6338 > include 'COMMON.TORSION'
6339 > include 'COMMON.VAR'
6340 > include 'COMMON.GEO'
6341 > double precision pizda(2,2),ggg1(3),ggg2(3)
6342 > cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6346 > cd print *,'eello4:',i,j,k,l,jj,kk
6347 > cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6348 > cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6349 > cold eij=facont_hb(jj,i)
6350 > cold ekl=facont_hb(kk,k)
6351 > cold ekont=eij*ekl
6352 > eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6353 > cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6354 > gcorr_loc(k-1)=gcorr_loc(k-1)
6355 > & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6356 > if (l.eq.j+1) then
6357 > gcorr_loc(l-1)=gcorr_loc(l-1)
6358 > & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6360 > gcorr_loc(j-1)=gcorr_loc(j-1)
6361 > & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6366 > derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6367 > & -EAEAderx(2,2,lll,kkk,iii,1)
6368 > cd derx(lll,kkk,iii)=0.0d0
6372 > cd gcorr_loc(l-1)=0.0d0
6373 > cd gcorr_loc(j-1)=0.0d0
6374 > cd gcorr_loc(k-1)=0.0d0
6376 > cd write (iout,*)'Contacts have occurred for peptide groups',
6377 > cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6378 > cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6379 > if (j.lt.nres-1) then
6386 > if (l.lt.nres-1) then
6394 > cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6395 > ggg1(ll)=eel4*g_contij(ll,1)
6396 > ggg2(ll)=eel4*g_contij(ll,2)
6397 > ghalf=0.5d0*ggg1(ll)
6399 > gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6400 > gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6401 > gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6402 > gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6403 > cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6404 > ghalf=0.5d0*ggg2(ll)
6406 > gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6407 > gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6408 > gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6409 > gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6414 > cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6415 > gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6420 > cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6421 > gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6427 > gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6432 > gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6435 > cd do iii=1,nres-3
6436 > cd write (2,*) iii,gcorr_loc(iii)
6439 > cd write (2,*) 'ekont',ekont
6440 > cd write (iout,*) 'eello4',ekont*eel4
6443 > C---------------------------------------------------------------------------
6444 > double precision function eello5(i,j,k,l,jj,kk)
6445 > implicit real*8 (a-h,o-z)
6446 > include 'DIMENSIONS'
6447 > include 'COMMON.IOUNITS'
6448 > include 'COMMON.CHAIN'
6449 > include 'COMMON.DERIV'
6450 > include 'COMMON.INTERACT'
6451 > include 'COMMON.CONTACTS'
6452 > include 'COMMON.TORSION'
6453 > include 'COMMON.VAR'
6454 > include 'COMMON.GEO'
6455 > double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6456 > double precision ggg1(3),ggg2(3)
6457 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6459 > C Parallel chains C
6462 > C /l\ / \ \ / \ / \ / C
6463 > C / \ / \ \ / \ / \ / C
6464 > C j| o |l1 | o | o| o | | o |o C
6465 > C \ |/k\| |/ \| / |/ \| |/ \| C
6466 > C \i/ \ / \ / / \ / \ C
6468 > C (I) (II) (III) (IV) C
6470 > C eello5_1 eello5_2 eello5_3 eello5_4 C
6472 > C Antiparallel chains C
6475 > C /j\ / \ \ / \ / \ / C
6476 > C / \ / \ \ / \ / \ / C
6477 > C j1| o |l | o | o| o | | o |o C
6478 > C \ |/k\| |/ \| / |/ \| |/ \| C
6479 > C \i/ \ / \ / / \ / \ C
6481 > C (I) (II) (III) (IV) C
6483 > C eello5_1 eello5_2 eello5_3 eello5_4 C
6485 > C o denotes a local interaction, vertical lines an electrostatic interaction. C
6487 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6488 > cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6493 > cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6495 > itk=itortyp(itype(k))
6496 > itl=itortyp(itype(l))
6497 > itj=itortyp(itype(j))
6502 > cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6503 > cd & eel5_3_num,eel5_4_num)
6507 > derx(lll,kkk,iii)=0.0d0
6511 > cd eij=facont_hb(jj,i)
6512 > cd ekl=facont_hb(kk,k)
6514 > cd write (iout,*)'Contacts have occurred for peptide groups',
6515 > cd & i,j,' fcont:',eij,' eij',' and ',k,l
6517 > C Contribution from the graph I.
6518 > cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6519 > cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6520 > call transpose2(EUg(1,1,k),auxmat(1,1))
6521 > call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6522 > vv(1)=pizda(1,1)-pizda(2,2)
6523 > vv(2)=pizda(1,2)+pizda(2,1)
6524 > eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6525 > & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6526 > C Explicit gradient in virtual-dihedral angles.
6527 > if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6528 > & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6529 > & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6530 > call transpose2(EUgder(1,1,k),auxmat1(1,1))
6531 > call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6532 > vv(1)=pizda(1,1)-pizda(2,2)
6533 > vv(2)=pizda(1,2)+pizda(2,1)
6534 > g_corr5_loc(k-1)=g_corr5_loc(k-1)
6535 > & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6536 > & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6537 > call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6538 > vv(1)=pizda(1,1)-pizda(2,2)
6539 > vv(2)=pizda(1,2)+pizda(2,1)
6540 > if (l.eq.j+1) then
6541 > if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6542 > & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6543 > & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6545 > if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6546 > & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6547 > & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6549 > C Cartesian gradient
6553 > call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6555 > vv(1)=pizda(1,1)-pizda(2,2)
6556 > vv(2)=pizda(1,2)+pizda(2,1)
6557 > derx(lll,kkk,iii)=derx(lll,kkk,iii)
6558 > & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6559 > & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6565 > C Contribution from graph II
6566 > call transpose2(EE(1,1,itk),auxmat(1,1))
6567 > call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6568 > vv(1)=pizda(1,1)+pizda(2,2)
6569 > vv(2)=pizda(2,1)-pizda(1,2)
6570 > eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6571 > & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6572 > C Explicit gradient in virtual-dihedral angles.
6573 > g_corr5_loc(k-1)=g_corr5_loc(k-1)
6574 > & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6575 > call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6576 > vv(1)=pizda(1,1)+pizda(2,2)
6577 > vv(2)=pizda(2,1)-pizda(1,2)
6578 > if (l.eq.j+1) then
6579 > g_corr5_loc(l-1)=g_corr5_loc(l-1)
6580 > & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6581 > & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6583 > g_corr5_loc(j-1)=g_corr5_loc(j-1)
6584 > & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6585 > & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6587 > C Cartesian gradient
6591 > call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6593 > vv(1)=pizda(1,1)+pizda(2,2)
6594 > vv(2)=pizda(2,1)-pizda(1,2)
6595 > derx(lll,kkk,iii)=derx(lll,kkk,iii)
6596 > & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6597 > & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6603 > if (l.eq.j+1) then
6605 > C Parallel orientation
6606 > C Contribution from graph III
6607 > call transpose2(EUg(1,1,l),auxmat(1,1))
6608 > call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6609 > vv(1)=pizda(1,1)-pizda(2,2)
6610 > vv(2)=pizda(1,2)+pizda(2,1)
6611 > eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6612 > & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6613 > C Explicit gradient in virtual-dihedral angles.
6614 > g_corr5_loc(j-1)=g_corr5_loc(j-1)
6615 > & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6616 > & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6617 > call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6618 > vv(1)=pizda(1,1)-pizda(2,2)
6619 > vv(2)=pizda(1,2)+pizda(2,1)
6620 > g_corr5_loc(k-1)=g_corr5_loc(k-1)
6621 > & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6622 > & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6623 > call transpose2(EUgder(1,1,l),auxmat1(1,1))
6624 > call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6625 > vv(1)=pizda(1,1)-pizda(2,2)
6626 > vv(2)=pizda(1,2)+pizda(2,1)
6627 > g_corr5_loc(l-1)=g_corr5_loc(l-1)
6628 > & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6629 > & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6630 > C Cartesian gradient
6634 > call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6636 > vv(1)=pizda(1,1)-pizda(2,2)
6637 > vv(2)=pizda(1,2)+pizda(2,1)
6638 > derx(lll,kkk,iii)=derx(lll,kkk,iii)
6639 > & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6640 > & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6645 > C Contribution from graph IV
6647 > call transpose2(EE(1,1,itl),auxmat(1,1))
6648 > call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6649 > vv(1)=pizda(1,1)+pizda(2,2)
6650 > vv(2)=pizda(2,1)-pizda(1,2)
6651 > eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6652 > & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6653 > C Explicit gradient in virtual-dihedral angles.
6654 > g_corr5_loc(l-1)=g_corr5_loc(l-1)
6655 > & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6656 > call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6657 > vv(1)=pizda(1,1)+pizda(2,2)
6658 > vv(2)=pizda(2,1)-pizda(1,2)
6659 > g_corr5_loc(k-1)=g_corr5_loc(k-1)
6660 > & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6661 > & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6662 > C Cartesian gradient
6666 > call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6668 > vv(1)=pizda(1,1)+pizda(2,2)
6669 > vv(2)=pizda(2,1)-pizda(1,2)
6670 > derx(lll,kkk,iii)=derx(lll,kkk,iii)
6671 > & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6672 > & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6677 > C Antiparallel orientation
6678 > C Contribution from graph III
6680 > call transpose2(EUg(1,1,j),auxmat(1,1))
6681 > call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6682 > vv(1)=pizda(1,1)-pizda(2,2)
6683 > vv(2)=pizda(1,2)+pizda(2,1)
6684 > eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6685 > & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6686 > C Explicit gradient in virtual-dihedral angles.
6687 > g_corr5_loc(l-1)=g_corr5_loc(l-1)
6688 > & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6689 > & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6690 > call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6691 > vv(1)=pizda(1,1)-pizda(2,2)
6692 > vv(2)=pizda(1,2)+pizda(2,1)
6693 > g_corr5_loc(k-1)=g_corr5_loc(k-1)
6694 > & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6695 > & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6696 > call transpose2(EUgder(1,1,j),auxmat1(1,1))
6697 > call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6698 > vv(1)=pizda(1,1)-pizda(2,2)
6699 > vv(2)=pizda(1,2)+pizda(2,1)
6700 > g_corr5_loc(j-1)=g_corr5_loc(j-1)
6701 > & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6702 > & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6703 > C Cartesian gradient
6707 > call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6709 > vv(1)=pizda(1,1)-pizda(2,2)
6710 > vv(2)=pizda(1,2)+pizda(2,1)
6711 > derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6712 > & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6713 > & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6718 > C Contribution from graph IV
6720 > call transpose2(EE(1,1,itj),auxmat(1,1))
6721 > call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6722 > vv(1)=pizda(1,1)+pizda(2,2)
6723 > vv(2)=pizda(2,1)-pizda(1,2)
6724 > eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6725 > & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6726 > C Explicit gradient in virtual-dihedral angles.
6727 > g_corr5_loc(j-1)=g_corr5_loc(j-1)
6728 > & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6729 > call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6730 > vv(1)=pizda(1,1)+pizda(2,2)
6731 > vv(2)=pizda(2,1)-pizda(1,2)
6732 > g_corr5_loc(k-1)=g_corr5_loc(k-1)
6733 > & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6734 > & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6735 > C Cartesian gradient
6739 > call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6741 > vv(1)=pizda(1,1)+pizda(2,2)
6742 > vv(2)=pizda(2,1)-pizda(1,2)
6743 > derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6744 > & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6745 > & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6751 > eel5=eello5_1+eello5_2+eello5_3+eello5_4
6752 > cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6753 > cd write (2,*) 'ijkl',i,j,k,l
6754 > cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6755 > cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6757 > cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6758 > cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6759 > cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6760 > cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6761 > if (j.lt.nres-1) then
6768 > if (l.lt.nres-1) then
6778 > cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6780 > ggg1(ll)=eel5*g_contij(ll,1)
6781 > ggg2(ll)=eel5*g_contij(ll,2)
6782 > cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6783 > ghalf=0.5d0*ggg1(ll)
6785 > gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6786 > gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6787 > gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6788 > gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6789 > cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6790 > ghalf=0.5d0*ggg2(ll)
6792 > gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6793 > gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6794 > gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6795 > gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6800 > cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6801 > gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6806 > cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6807 > gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6813 > gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6818 > gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6821 > cd do iii=1,nres-3
6822 > cd write (2,*) iii,g_corr5_loc(iii)
6825 > cd write (2,*) 'ekont',ekont
6826 > cd write (iout,*) 'eello5',ekont*eel5
6829 > c--------------------------------------------------------------------------
6830 > double precision function eello6(i,j,k,l,jj,kk)
6831 > implicit real*8 (a-h,o-z)
6832 > include 'DIMENSIONS'
6833 > include 'COMMON.IOUNITS'
6834 > include 'COMMON.CHAIN'
6835 > include 'COMMON.DERIV'
6836 > include 'COMMON.INTERACT'
6837 > include 'COMMON.CONTACTS'
6838 > include 'COMMON.TORSION'
6839 > include 'COMMON.VAR'
6840 > include 'COMMON.GEO'
6841 > include 'COMMON.FFIELD'
6842 > double precision ggg1(3),ggg2(3)
6843 > cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6848 > cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6856 > cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6857 > cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6861 > derx(lll,kkk,iii)=0.0d0
6865 > cd eij=facont_hb(jj,i)
6866 > cd ekl=facont_hb(kk,k)
6871 > if (l.eq.j+1) then
6872 > eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6873 > eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6874 > eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6875 > eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6876 > eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6877 > eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6879 > eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6880 > eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6881 > eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6882 > eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6883 > if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6884 > eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6888 > eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6890 > C If turn contributions are considered, they will be handled separately.
6891 > eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6892 > cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6893 > cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6894 > cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6895 > cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6896 > cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6897 > cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6899 > if (j.lt.nres-1) then
6906 > if (l.lt.nres-1) then
6914 > ggg1(ll)=eel6*g_contij(ll,1)
6915 > ggg2(ll)=eel6*g_contij(ll,2)
6916 > cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6917 > ghalf=0.5d0*ggg1(ll)
6919 > gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6920 > gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6921 > gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6922 > gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6923 > ghalf=0.5d0*ggg2(ll)
6924 > cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6926 > gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6927 > gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6928 > gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6929 > gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6934 > cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6935 > gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6940 > cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6941 > gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6947 > gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6952 > gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6955 > cd do iii=1,nres-3
6956 > cd write (2,*) iii,g_corr6_loc(iii)
6959 > cd write (2,*) 'ekont',ekont
6960 > cd write (iout,*) 'eello6',ekont*eel6
6963 > c--------------------------------------------------------------------------
6964 > double precision function eello6_graph1(i,j,k,l,imat,swap)
6965 > implicit real*8 (a-h,o-z)
6966 > include 'DIMENSIONS'
6967 > include 'COMMON.IOUNITS'
6968 > include 'COMMON.CHAIN'
6969 > include 'COMMON.DERIV'
6970 > include 'COMMON.INTERACT'
6971 > include 'COMMON.CONTACTS'
6972 > include 'COMMON.TORSION'
6973 > include 'COMMON.VAR'
6974 > include 'COMMON.GEO'
6975 > double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6978 > common /kutas/ lprn
6979 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6981 > C Parallel Antiparallel
6987 > C \ j|/k\| / \ |/k\|l /
6992 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6993 > itk=itortyp(itype(k))
6994 > s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6995 > s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6996 > s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6997 > call transpose2(EUgC(1,1,k),auxmat(1,1))
6998 > call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6999 > vv1(1)=pizda1(1,1)-pizda1(2,2)
7000 > vv1(2)=pizda1(1,2)+pizda1(2,1)
7001 > s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7002 > vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7003 > vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7004 > s5=scalar2(vv(1),Dtobr2(1,i))
7005 > cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7006 > eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7007 > if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7008 > & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7009 > & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7010 > & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7011 > & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7012 > & +scalar2(vv(1),Dtobr2der(1,i)))
7013 > call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7014 > vv1(1)=pizda1(1,1)-pizda1(2,2)
7015 > vv1(2)=pizda1(1,2)+pizda1(2,1)
7016 > vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7017 > vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7018 > if (l.eq.j+1) then
7019 > g_corr6_loc(l-1)=g_corr6_loc(l-1)
7020 > & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7021 > & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7022 > & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7023 > & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7025 > g_corr6_loc(j-1)=g_corr6_loc(j-1)
7026 > & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7027 > & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7028 > & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7029 > & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7031 > call transpose2(EUgCder(1,1,k),auxmat(1,1))
7032 > call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7033 > vv1(1)=pizda1(1,1)-pizda1(2,2)
7034 > vv1(2)=pizda1(1,2)+pizda1(2,1)
7035 > if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7036 > & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7037 > & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7038 > & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7047 > s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7048 > s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7049 > s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7050 > call transpose2(EUgC(1,1,k),auxmat(1,1))
7051 > call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7053 > vv1(1)=pizda1(1,1)-pizda1(2,2)
7054 > vv1(2)=pizda1(1,2)+pizda1(2,1)
7055 > s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7056 > vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7057 > & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7058 > vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7059 > & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7060 > s5=scalar2(vv(1),Dtobr2(1,i))
7061 > derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7067 > c----------------------------------------------------------------------------
7068 > double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7069 > implicit real*8 (a-h,o-z)
7070 > include 'DIMENSIONS'
7071 > include 'COMMON.IOUNITS'
7072 > include 'COMMON.CHAIN'
7073 > include 'COMMON.DERIV'
7074 > include 'COMMON.INTERACT'
7075 > include 'COMMON.CONTACTS'
7076 > include 'COMMON.TORSION'
7077 > include 'COMMON.VAR'
7078 > include 'COMMON.GEO'
7080 > double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7081 > & auxvec1(2),auxvec2(1),auxmat1(2,2)
7083 > common /kutas/ lprn
7084 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7086 > C Parallel Antiparallel
7092 > C \ j|/k\| \ |/k\|l
7097 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7098 > cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7099 > C AL 7/4/01 s1 would occur in the sixth-order moment,
7100 > C but not in a cluster cumulant
7102 > s1=dip(1,jj,i)*dip(1,kk,k)
7104 > call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7105 > s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7106 > call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7107 > s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7108 > call transpose2(EUg(1,1,k),auxmat(1,1))
7109 > call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7110 > vv(1)=pizda(1,1)-pizda(2,2)
7111 > vv(2)=pizda(1,2)+pizda(2,1)
7112 > s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7113 > cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7115 > eello6_graph2=-(s1+s2+s3+s4)
7117 > eello6_graph2=-(s2+s3+s4)
7119 > c eello6_graph2=-s3
7120 > C Derivatives in gamma(i-1)
7123 > s1=dipderg(1,jj,i)*dip(1,kk,k)
7125 > s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7126 > call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7127 > s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7128 > s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7130 > g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7132 > g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7134 > c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7136 > C Derivatives in gamma(k-1)
7138 > s1=dip(1,jj,i)*dipderg(1,kk,k)
7140 > call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7141 > s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7142 > call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7143 > s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7144 > call transpose2(EUgder(1,1,k),auxmat1(1,1))
7145 > call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7146 > vv(1)=pizda(1,1)-pizda(2,2)
7147 > vv(2)=pizda(1,2)+pizda(2,1)
7148 > s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7150 > g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7152 > g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7154 > c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7155 > C Derivatives in gamma(j-1) or gamma(l-1)
7158 > s1=dipderg(3,jj,i)*dip(1,kk,k)
7160 > call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7161 > s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7162 > s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7163 > call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7164 > vv(1)=pizda(1,1)-pizda(2,2)
7165 > vv(2)=pizda(1,2)+pizda(2,1)
7166 > s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7169 > g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7171 > g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7174 > g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7175 > c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7177 > C Derivatives in gamma(l-1) or gamma(j-1)
7180 > s1=dip(1,jj,i)*dipderg(3,kk,k)
7182 > call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7183 > s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7184 > call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7185 > s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7186 > call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7187 > vv(1)=pizda(1,1)-pizda(2,2)
7188 > vv(2)=pizda(1,2)+pizda(2,1)
7189 > s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7192 > g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7194 > g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7197 > g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7198 > c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7200 > C Cartesian derivatives.
7202 > write (2,*) 'In eello6_graph2'
7204 > write (2,*) 'iii=',iii
7206 > write (2,*) 'kkk=',kkk
7208 > write (2,'(3(2f10.5),5x)')
7209 > & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7218 > if (iii.eq.1) then
7219 > s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7221 > s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7224 > call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7226 > s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7227 > call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7229 > s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7230 > call transpose2(EUg(1,1,k),auxmat(1,1))
7231 > call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7233 > vv(1)=pizda(1,1)-pizda(2,2)
7234 > vv(2)=pizda(1,2)+pizda(2,1)
7235 > s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7236 > cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7238 > derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7240 > derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7243 > derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7245 > derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7252 > c----------------------------------------------------------------------------
7253 > double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7254 > implicit real*8 (a-h,o-z)
7255 > include 'DIMENSIONS'
7256 > include 'COMMON.IOUNITS'
7257 > include 'COMMON.CHAIN'
7258 > include 'COMMON.DERIV'
7259 > include 'COMMON.INTERACT'
7260 > include 'COMMON.CONTACTS'
7261 > include 'COMMON.TORSION'
7262 > include 'COMMON.VAR'
7263 > include 'COMMON.GEO'
7264 > double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7266 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7268 > C Parallel Antiparallel
7274 > C j|/k\| / |/k\|l /
7279 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7281 > C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7282 > C energy moment and not to the cluster cumulant.
7283 > iti=itortyp(itype(i))
7284 > if (j.lt.nres-1) then
7285 > itj1=itortyp(itype(j+1))
7289 > itk=itortyp(itype(k))
7290 > itk1=itortyp(itype(k+1))
7291 > if (l.lt.nres-1) then
7292 > itl1=itortyp(itype(l+1))
7297 > s1=dip(4,jj,i)*dip(4,kk,k)
7299 > call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7300 > s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7301 > call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7302 > s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7303 > call transpose2(EE(1,1,itk),auxmat(1,1))
7304 > call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7305 > vv(1)=pizda(1,1)+pizda(2,2)
7306 > vv(2)=pizda(2,1)-pizda(1,2)
7307 > s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7308 > cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7310 > eello6_graph3=-(s1+s2+s3+s4)
7312 > eello6_graph3=-(s2+s3+s4)
7314 > c eello6_graph3=-s4
7315 > C Derivatives in gamma(k-1)
7316 > call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7317 > s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7318 > s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7319 > g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7320 > C Derivatives in gamma(l-1)
7321 > call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7322 > s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7323 > call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7324 > vv(1)=pizda(1,1)+pizda(2,2)
7325 > vv(2)=pizda(2,1)-pizda(1,2)
7326 > s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7327 > g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7328 > C Cartesian derivatives.
7333 > if (iii.eq.1) then
7334 > s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7336 > s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7339 > call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7341 > s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7342 > call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7344 > s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7345 > call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7347 > vv(1)=pizda(1,1)+pizda(2,2)
7348 > vv(2)=pizda(2,1)-pizda(1,2)
7349 > s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7351 > derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7353 > derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7356 > derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7358 > derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7360 > c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7366 > c----------------------------------------------------------------------------
7367 > double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7368 > implicit real*8 (a-h,o-z)
7369 > include 'DIMENSIONS'
7370 > include 'COMMON.IOUNITS'
7371 > include 'COMMON.CHAIN'
7372 > include 'COMMON.DERIV'
7373 > include 'COMMON.INTERACT'
7374 > include 'COMMON.CONTACTS'
7375 > include 'COMMON.TORSION'
7376 > include 'COMMON.VAR'
7377 > include 'COMMON.GEO'
7378 > include 'COMMON.FFIELD'
7379 > double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7380 > & auxvec1(2),auxmat1(2,2)
7382 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7384 > C Parallel Antiparallel
7390 > C \ j|/k\| \ |/k\|l
7395 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7397 > C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7398 > C energy moment and not to the cluster cumulant.
7399 > cd write (2,*) 'eello_graph4: wturn6',wturn6
7400 > iti=itortyp(itype(i))
7401 > itj=itortyp(itype(j))
7402 > if (j.lt.nres-1) then
7403 > itj1=itortyp(itype(j+1))
7407 > itk=itortyp(itype(k))
7408 > if (k.lt.nres-1) then
7409 > itk1=itortyp(itype(k+1))
7413 > itl=itortyp(itype(l))
7414 > if (l.lt.nres-1) then
7415 > itl1=itortyp(itype(l+1))
7419 > cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7420 > cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7421 > cd & ' itl',itl,' itl1',itl1
7423 > if (imat.eq.1) then
7424 > s1=dip(3,jj,i)*dip(3,kk,k)
7426 > s1=dip(2,jj,j)*dip(2,kk,l)
7429 > call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7430 > s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7431 > if (j.eq.l+1) then
7432 > call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7433 > s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7435 > call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7436 > s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7438 > call transpose2(EUg(1,1,k),auxmat(1,1))
7439 > call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7440 > vv(1)=pizda(1,1)-pizda(2,2)
7441 > vv(2)=pizda(2,1)+pizda(1,2)
7442 > s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7443 > cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7445 > eello6_graph4=-(s1+s2+s3+s4)
7447 > eello6_graph4=-(s2+s3+s4)
7449 > C Derivatives in gamma(i-1)
7452 > if (imat.eq.1) then
7453 > s1=dipderg(2,jj,i)*dip(3,kk,k)
7455 > s1=dipderg(4,jj,j)*dip(2,kk,l)
7458 > s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7459 > if (j.eq.l+1) then
7460 > call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7461 > s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7463 > call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7464 > s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7466 > s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7467 > if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7468 > cd write (2,*) 'turn6 derivatives'
7470 > gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7472 > gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7476 > g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7478 > g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7482 > C Derivatives in gamma(k-1)
7484 > if (imat.eq.1) then
7485 > s1=dip(3,jj,i)*dipderg(2,kk,k)
7487 > s1=dip(2,jj,j)*dipderg(4,kk,l)
7490 > call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7491 > s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7492 > if (j.eq.l+1) then
7493 > call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7494 > s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7496 > call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7497 > s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7499 > call transpose2(EUgder(1,1,k),auxmat1(1,1))
7500 > call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7501 > vv(1)=pizda(1,1)-pizda(2,2)
7502 > vv(2)=pizda(2,1)+pizda(1,2)
7503 > s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7504 > if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7506 > gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7508 > gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7512 > g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7514 > g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7517 > C Derivatives in gamma(j-1) or gamma(l-1)
7518 > if (l.eq.j+1 .and. l.gt.1) then
7519 > call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7520 > s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7521 > call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7522 > vv(1)=pizda(1,1)-pizda(2,2)
7523 > vv(2)=pizda(2,1)+pizda(1,2)
7524 > s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7525 > g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7526 > else if (j.gt.1) then
7527 > call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7528 > s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7529 > call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7530 > vv(1)=pizda(1,1)-pizda(2,2)
7531 > vv(2)=pizda(2,1)+pizda(1,2)
7532 > s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7533 > if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7534 > gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7536 > g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7539 > C Cartesian derivatives.
7544 > if (iii.eq.1) then
7545 > if (imat.eq.1) then
7546 > s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7548 > s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7551 > if (imat.eq.1) then
7552 > s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7554 > s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7558 > call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7560 > s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7561 > if (j.eq.l+1) then
7562 > call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7563 > & b1(1,itj1),auxvec(1))
7564 > s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7566 > call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7567 > & b1(1,itl1),auxvec(1))
7568 > s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7570 > call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7572 > vv(1)=pizda(1,1)-pizda(2,2)
7573 > vv(2)=pizda(2,1)+pizda(1,2)
7574 > s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7576 > if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7578 > derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7581 > derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7584 > derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7587 > derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7589 > derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7591 > derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7595 > derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7597 > derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7599 > if (l.eq.j+1) then
7600 > derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7602 > derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7610 > c----------------------------------------------------------------------------
7611 > double precision function eello_turn6(i,jj,kk)
7612 > implicit real*8 (a-h,o-z)
7613 > include 'DIMENSIONS'
7614 > include 'COMMON.IOUNITS'
7615 > include 'COMMON.CHAIN'
7616 > include 'COMMON.DERIV'
7617 > include 'COMMON.INTERACT'
7618 > include 'COMMON.CONTACTS'
7619 > include 'COMMON.TORSION'
7620 > include 'COMMON.VAR'
7621 > include 'COMMON.GEO'
7622 > double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7623 > & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7625 > double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7626 > & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7627 > C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7628 > C the respective energy moment and not to the cluster cumulant.
7637 > iti=itortyp(itype(i))
7638 > itk=itortyp(itype(k))
7639 > itk1=itortyp(itype(k+1))
7640 > itl=itortyp(itype(l))
7641 > itj=itortyp(itype(j))
7642 > cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7643 > cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7644 > cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7649 > cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7651 > cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7655 > derx_turn(lll,kkk,iii)=0.0d0
7662 > eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7664 > cd write (2,*) 'eello6_5',eello6_5
7666 > call transpose2(AEA(1,1,1),auxmat(1,1))
7667 > call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7668 > ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7669 > s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7671 > call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7672 > call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7673 > s2 = scalar2(b1(1,itk),vtemp1(1))
7675 > call transpose2(AEA(1,1,2),atemp(1,1))
7676 > call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7677 > call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7678 > s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7680 > call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7681 > call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7682 > s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7684 > call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7685 > call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7686 > call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7687 > call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7688 > ss13 = scalar2(b1(1,itk),vtemp4(1))
7689 > s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7691 > c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7697 > eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7698 > C Derivatives in gamma(i+2)
7702 > call transpose2(AEA(1,1,1),auxmatd(1,1))
7703 > call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7704 > s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7705 > call transpose2(AEAderg(1,1,2),atempd(1,1))
7706 > call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7707 > s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7709 > call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7710 > call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7711 > s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7717 > gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7718 > C Derivatives in gamma(i+3)
7720 > call transpose2(AEA(1,1,1),auxmatd(1,1))
7721 > call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7722 > ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7723 > s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7725 > call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7726 > call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7727 > s2d = scalar2(b1(1,itk),vtemp1d(1))
7729 > call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7730 > s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7732 > s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7734 > call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7735 > call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7736 > s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7744 > gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7745 > & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7747 > gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7748 > & -0.5d0*ekont*(s2d+s12d)
7750 > C Derivatives in gamma(i+4)
7751 > call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7752 > call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7753 > s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7755 > call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7756 > call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7757 > s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7765 > gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7767 > gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7769 > C Derivatives in gamma(i+5)
7771 > call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7772 > call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7773 > s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7775 > call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7776 > call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7777 > s2d = scalar2(b1(1,itk),vtemp1d(1))
7779 > call transpose2(AEA(1,1,2),atempd(1,1))
7780 > call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7781 > s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7783 > call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7784 > s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7786 > call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7787 > ss13d = scalar2(b1(1,itk),vtemp4d(1))
7788 > s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7796 > gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7797 > & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7799 > gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7800 > & -0.5d0*ekont*(s2d+s12d)
7802 > C Cartesian derivatives
7807 > call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7808 > call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7809 > s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7811 > call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7812 > call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7814 > s2d = scalar2(b1(1,itk),vtemp1d(1))
7816 > call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7817 > call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7818 > s8d = -(atempd(1,1)+atempd(2,2))*
7819 > & scalar2(cc(1,1,itl),vtemp2(1))
7821 > call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7823 > call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7824 > s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7831 > derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7832 > & - 0.5d0*(s1d+s2d)
7834 > derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7838 > derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7839 > & - 0.5d0*(s8d+s12d)
7841 > derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7850 > call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7851 > & achuj_tempd(1,1))
7852 > call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7853 > call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7854 > s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7855 > derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7856 > call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7858 > ss13d = scalar2(b1(1,itk),vtemp4d(1))
7859 > s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7860 > derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7864 > cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7865 > cd & 16*eel_turn6_num
7867 > if (j.lt.nres-1) then
7874 > if (l.lt.nres-1) then
7882 > ggg1(ll)=eel_turn6*g_contij(ll,1)
7883 > ggg2(ll)=eel_turn6*g_contij(ll,2)
7884 > ghalf=0.5d0*ggg1(ll)
7886 > gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7887 > & +ekont*derx_turn(ll,2,1)
7888 > gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7889 > gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7890 > & +ekont*derx_turn(ll,4,1)
7891 > gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7892 > ghalf=0.5d0*ggg2(ll)
7894 > gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7895 > & +ekont*derx_turn(ll,2,2)
7896 > gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7897 > gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7898 > & +ekont*derx_turn(ll,4,2)
7899 > gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7904 > gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7909 > gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7915 > gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7920 > gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7923 > cd do iii=1,nres-3
7924 > cd write (2,*) iii,g_corr6_loc(iii)
7926 > eello_turn6=ekont*eel_turn6
7927 > cd write (2,*) 'ekont',ekont
7928 > cd write (2,*) 'eel_turn6',ekont*eel_turn6
7932 > C-----------------------------------------------------------------------------
7933 > double precision function scalar(u,v)
7934 > !DIR$ INLINEALWAYS scalar
7936 > cDEC$ ATTRIBUTES FORCEINLINE::scalar
7939 > double precision u(3),v(3)
7940 > cd double precision sc
7944 > cd sc=sc+u(i)*v(i)
7948 > scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
7951 > crc-------------------------------------------------
7952 > SUBROUTINE MATVEC2(A1,V1,V2)
7953 > !DIR$ INLINEALWAYS MATVEC2
7955 > cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
7957 > implicit real*8 (a-h,o-z)
7958 > include 'DIMENSIONS'
7959 > DIMENSION A1(2,2),V1(2),V2(2)
7963 > c 3 VI=VI+A1(I,K)*V1(K)
7967 > vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7968 > vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7973 > C---------------------------------------
7974 > SUBROUTINE MATMAT2(A1,A2,A3)
7976 > cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
7978 > implicit real*8 (a-h,o-z)
7979 > include 'DIMENSIONS'
7980 > DIMENSION A1(2,2),A2(2,2),A3(2,2)
7981 > c DIMENSION AI3(2,2)
7985 > c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7991 > ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7992 > ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7993 > ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7994 > ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8002 > c-------------------------------------------------------------------------
8003 > double precision function scalar2(u,v)
8004 > !DIR$ INLINEALWAYS scalar2
8006 > double precision u(2),v(2)
8007 > double precision sc
8009 > scalar2=u(1)*v(1)+u(2)*v(2)
8013 > C-----------------------------------------------------------------------------
8015 > subroutine transpose2(a,at)
8016 > !DIR$ INLINEALWAYS transpose2
8018 > cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8021 > double precision a(2,2),at(2,2)
8028 > c--------------------------------------------------------------------------
8029 > subroutine transpose(n,a,at)
8032 > double precision a(n,n),at(n,n)
8040 > C---------------------------------------------------------------------------
8041 > subroutine prodmat3(a1,a2,kk,transp,prod)
8042 > !DIR$ INLINEALWAYS prodmat3
8044 > cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8048 > double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8050 > crc double precision auxmat(2,2),prod_(2,2)
8053 > crc call transpose2(kk(1,1),auxmat(1,1))
8054 > crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8055 > crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8057 > prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8058 > & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8059 > prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8060 > & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8061 > prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8062 > & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8063 > prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8064 > & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8067 > crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8068 > crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8070 > prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8071 > & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8072 > prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8073 > & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8074 > prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8075 > & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8076 > prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8077 > & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8080 > c call transpose2(a2(1,1),a2t(1,1))
8082 > crc print *,transp
8083 > crc print *,((prod_(i,j),i=1,2),j=1,2)
8084 > crc print *,((prod(i,j),i=1,2),j=1,2)