2 !-----------------------------------------------------------------------------
13 !-----------------------------------------------------------------------------
14 ! Max. number of variables
16 !-----------------------------------------------------------------------------
17 ! Max number of torsional terms in SCCOR
18 integer,parameter :: maxterm_sccor=6
19 !-----------------------------------------------------------------------------
20 ! Maximum number of SC local term fitting function coefficiants
21 integer,parameter :: maxsccoef=65
22 !-----------------------------------------------------------------------------
25 ! Change 12/1/95 - common block CONTACTS1 included.
27 integer,dimension(:),allocatable :: num_cont !(maxres)
28 integer,dimension(:,:),allocatable :: jcont !(maxconts,maxres)
29 real(kind=8),dimension(:,:),allocatable :: facont !(maxconts,maxres)
30 real(kind=8),dimension(:,:,:),allocatable :: gacont !(3,maxconts,maxres)
32 ! 12/26/95 - H-bonding contacts
33 ! common /contacts_hb/
34 real(kind=8),dimension(:,:,:),allocatable :: gacontp_hb1,gacontp_hb2,&
35 gacontp_hb3,gacontm_hb1,gacontm_hb2,gacontm_hb3,gacont_hbr,grij_hb_cont !(3,maxconts,maxres)
36 real(kind=8),dimension(:,:),allocatable :: facont_hb,ees0p,&
37 ees0m,d_cont !(maxconts,maxres)
38 integer,dimension(:),allocatable :: num_cont_hb !(maxres)
39 integer,dimension(:,:),allocatable :: jcont_hb !(maxconts,maxres)
40 ! 9/23/99 Added improper rotation matrices and matrices of dipole-dipole
42 ! 7/25/08 commented out; not needed when cumulants used
43 ! Interactions of pseudo-dipoles generated by loc-el interactions.
45 real(kind=8),dimension(:,:,:),allocatable :: dip,&
46 dipderg !(4,maxconts,maxres)
47 real(kind=8),dimension(:,:,:,:,:),allocatable :: dipderx !(3,5,4,maxconts,maxres)
48 ! 10/30/99 Added other pre-computed vectors and matrices needed
49 ! to calculate three - six-order el-loc correlation terms
51 real(kind=8),dimension(:,:,:),allocatable :: Ug,Ugder,Ug2,Ug2der !(2,2,maxres)
52 real(kind=8),dimension(:,:),allocatable :: obrot,obrot2,obrot_der,&
53 obrot2_der !(2,maxres)
55 ! This common block contains vectors and matrices dependent on a single
58 real(kind=8),dimension(:,:),allocatable :: mu,muder,Ub2,Ub2der,&
59 Ctobr,Ctobrder,Dtobr2,Dtobr2der !(2,maxres)
60 real(kind=8),dimension(:,:,:),allocatable :: EUg,EUgder,CUg,&
61 CUgder,DUg,Dugder,DtUg2,DtUg2der !(2,2,maxres)
62 ! This common block contains vectors and matrices dependent on two
63 ! consecutive amino-acid residues.
65 real(kind=8),dimension(:,:),allocatable :: Ug2Db1t,Ug2Db1tder,&
66 CUgb2,CUgb2der !(2,maxres)
67 real(kind=8),dimension(:,:,:),allocatable :: EUgC,EUgCder,&
68 EUgD,EUgDder,DtUg2EUg,Ug2DtEUg !(2,2,maxres)
69 real(kind=8),dimension(:,:,:,:),allocatable :: Ug2DtEUgder,&
70 DtUg2EUgder !(2,2,2,maxres)
72 real(kind=8),dimension(:),allocatable :: costab,sintab,&
73 costab2,sintab2 !(maxres)
74 ! This common block contains dipole-interaction matrices and their
75 ! Cartesian derivatives.
77 real(kind=8),dimension(:,:,:,:),allocatable :: a_chuj !(2,2,maxconts,maxres)
78 real(kind=8),dimension(:,:,:,:,:,:),allocatable :: a_chuj_der !(2,2,3,5,maxconts,maxres)
80 real(kind=8),dimension(2,2,2) :: AEA,AEAderg,EAEA,AECA,&
81 AECAderg,ADtEA,ADtEA1,AEAb1,AEAb1derg,AEAb2
82 real(kind=8),dimension(2,2,2,2) :: EAEAderg,ADtEAderg,&
84 real(kind=8),dimension(2,2,3,5,2,2) :: AEAderx,EAEAderx,&
85 AECAderx,ADtEAderx,ADtEA1derx
86 real(kind=8),dimension(2,3,5,2,2,2) :: AEAb1derx,AEAb2derx
87 real(kind=8),dimension(3,2) :: g_contij
89 ! 12/13/2008 (again Poland-Jaruzel war anniversary)
90 ! RE: Parallelization of 4th and higher order loc-el correlations
91 ! common /contdistrib/
92 integer,dimension(:),allocatable :: ncont_sent,ncont_recv !(maxres)
93 ! ncont_sent,ncont_recv są w multibody_ello i multibody_hb
94 !-----------------------------------------------------------------------------
97 ! real(kind=8),dimension(:,:),allocatable :: dcdv,dxdv !(6,maxdim)
98 ! real(kind=8),dimension(:,:),allocatable :: dxds !(6,maxres)
99 ! real(kind=8),dimension(:,:,:),allocatable :: gradx,gradc !(3,maxres,2)
100 real(kind=8),dimension(:,:),allocatable :: gvdwc,gelc,gelc_long,&
101 gvdwpp,gvdwc_scpp,gradx_scp,gvdwc_scp,ghpbx,ghpbc,&
102 gradcorr,gradcorr_long,gradcorr5_long,gradcorr6_long,&
103 gcorr6_turn_long,gradxorr,gradcorr5,gradcorr6 !(3,maxres)
104 ! real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2)
105 real(kind=8),dimension(:,:),allocatable :: gel_loc,gel_loc_long,&
106 gcorr3_turn,gcorr4_turn,gcorr6_turn,gradb,gradbx !(3,maxres)
107 real(kind=8),dimension(:),allocatable :: gel_loc_loc,&
108 gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc,g_corr5_loc,&
109 g_corr6_loc !(maxvar)
110 real(kind=8),dimension(:,:),allocatable :: gsccorc,gsccorx !(3,maxres)
111 real(kind=8),dimension(:),allocatable :: gsccor_loc !(maxres)
112 ! real(kind=8),dimension(:,:,:),allocatable :: dtheta !(3,2,maxres)
113 real(kind=8),dimension(:,:),allocatable :: gscloc,gsclocx !(3,maxres)
114 ! real(kind=8),dimension(:,:,:),allocatable :: dphi,dalpha,domega !(3,3,maxres)
117 real(kind=8),dimension(3,5,2) :: derx,derx_turn
118 ! common /deriv_scloc/
119 real(kind=8),dimension(:,:),allocatable :: dXX_C1tab,dYY_C1tab,&
120 dZZ_C1tab,dXX_Ctab,dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,&
121 dZZ_XYZtab !(3,maxres)
122 !-----------------------------------------------------------------------------
125 real(kind=8) :: gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,&
126 gradb_max,ghpbc_max,&
127 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
128 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
129 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
130 gsccorx_max,gsclocx_max
131 !-----------------------------------------------------------------------------
133 ! common /back_constr/
134 real(kind=8),dimension(:),allocatable :: dutheta,dugamma !(maxres)
135 real(kind=8),dimension(:,:),allocatable :: duscdiff,duscdiffx !(3,maxres)
137 real(kind=8) :: Ucdfrag,Ucdpair
138 real(kind=8),dimension(:,:),allocatable :: dUdconst,dUdxconst,&
139 dqwol,dxqwol !(3,0:MAXRES)
140 !-----------------------------------------------------------------------------
142 ! common /dyn_ssbond/
143 real(kind=8),dimension(:,:),allocatable :: dyn_ssbond_ij !(maxres,maxres)
144 !-----------------------------------------------------------------------------
146 ! Parameters of the SCCOR term
148 real(kind=8),dimension(:,:,:,:),allocatable :: dcostau,dsintau,&
149 dcosomicron,domicron !(3,3,3,maxres2)
150 !-----------------------------------------------------------------------------
153 real(kind=8),dimension(:,:),allocatable :: uy,uz !(3,maxres)
154 real(kind=8),dimension(:,:,:,:),allocatable :: uygrad,uzgrad !(3,3,2,maxres)
155 !-----------------------------------------------------------------------------
156 ! common /przechowalnia/
157 real(kind=8),dimension(:,:,:),allocatable :: zapas !(max_dim,maxconts,max_fg_procs)
158 real(kind=8),dimension(:,:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
159 !-----------------------------------------------------------------------------
160 !-----------------------------------------------------------------------------
163 !-----------------------------------------------------------------------------
165 !-----------------------------------------------------------------------------
166 ! energy_p_new_barrier.F
167 !-----------------------------------------------------------------------------
168 subroutine etotal(energia)
169 ! implicit real*8 (a-h,o-z)
170 ! include 'DIMENSIONS'
171 use MD_data, only: totT
175 !MS$ATTRIBUTES C :: proc_proc
181 ! include 'COMMON.SETUP'
182 ! include 'COMMON.IOUNITS'
183 real(kind=8),dimension(0:n_ene) :: energia
184 ! include 'COMMON.LOCAL'
185 ! include 'COMMON.FFIELD'
186 ! include 'COMMON.DERIV'
187 ! include 'COMMON.INTERACT'
188 ! include 'COMMON.SBRIDGE'
189 ! include 'COMMON.CHAIN'
190 ! include 'COMMON.VAR'
191 ! include 'COMMON.MD'
192 ! include 'COMMON.CONTROL'
193 ! include 'COMMON.TIME1'
194 real(kind=8) :: time00
196 integer :: n_corr,n_corr1,ierror
197 real(kind=8) :: etors,edihcnstr,etors_d,esccor,ehpb
198 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,escloc,ees,eel_loc
199 real(kind=8) :: eello_turn3,eello_turn4,estr,ebe
200 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
203 real(kind=8) :: weights_(n_ene) !,time_Bcast,time_Bcastw
204 ! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
205 ! & " nfgtasks",nfgtasks
206 if (nfgtasks.gt.1) then
208 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
209 if (fg_rank.eq.0) then
210 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
211 ! print *,"Processor",myrank," BROADCAST iorder"
212 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
213 ! FG slaves as WEIGHTS array.
233 ! FG Master broadcasts the WEIGHTS_ array
234 call MPI_Bcast(weights_(1),n_ene,&
235 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
237 ! FG slaves receive the WEIGHTS array
238 call MPI_Bcast(weights(1),n_ene,&
239 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
260 time_Bcast=time_Bcast+MPI_Wtime()-time00
261 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
262 ! call chainbuild_cart
264 ! print *,'Processor',myrank,' calling etotal ipot=',ipot
265 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
267 ! if (modecalc.eq.12.or.modecalc.eq.14) then
268 ! call int_from_cart1(.false.)
275 ! Compute the side-chain and electrostatic interaction energy
277 goto (101,102,103,104,105,106) ipot
278 ! Lennard-Jones potential.
280 !d print '(a)','Exit ELJcall el'
282 ! Lennard-Jones-Kihara potential (shifted).
285 ! Berne-Pechukas potential (dilated LJ, angular dependence).
288 ! Gay-Berne potential (shifted LJ, angular dependence).
291 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
294 ! Soft-sphere potential
295 106 call e_softsphere(evdw)
297 ! Calculate electrostatic (H-bonding) energy of the main chain.
302 !mc Sep-06: egb takes care of dynamic ss bonds too
304 ! if (dyn_ss) call dyn_set_nss
305 ! print *,"Processor",myrank," computed USCSC"
311 time_vec=time_vec+MPI_Wtime()-time01
313 ! print *,"Processor",myrank," left VEC_AND_DERIV"
316 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
317 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
318 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
319 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
321 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
322 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
323 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
324 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
326 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
335 ! write (iout,*) "Soft-spheer ELEC potential"
336 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
339 ! print *,"Processor",myrank," computed UELEC"
341 ! Calculate excluded-volume interaction energy between peptide groups
347 call escp(evdw2,evdw2_14)
353 ! write (iout,*) "Soft-sphere SCP potential"
354 call escp_soft_sphere(evdw2,evdw2_14)
358 ! Calculate the bond-stretching energy
362 ! Calculate the disulfide-bridge and other energy and the contributions
363 ! from other distance constraints.
364 print *,'Calling EHPB'
366 ! print *,'EHPB exitted succesfully.'
368 ! Calculate the virtual-bond-angle energy.
370 if (wang.gt.0d0) then
375 ! print *,"Processor",myrank," computed UB"
377 ! Calculate the SC local energy.
380 ! print *,"Processor",myrank," computed USC"
382 ! Calculate the virtual-bond torsional energy.
384 !d print *,'nterm=',nterm
386 call etor(etors,edihcnstr)
391 ! print *,"Processor",myrank," computed Utor"
393 ! 6/23/01 Calculate double-torsional energy
395 if (wtor_d.gt.0) then
400 ! print *,"Processor",myrank," computed Utord"
402 ! 21/5/07 Calculate local sicdechain correlation energy
404 if (wsccor.gt.0.0d0) then
405 call eback_sc_corr(esccor)
409 ! print *,"Processor",myrank," computed Usccorr"
411 ! 12/1/95 Multi-body terms
415 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
416 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
417 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
418 !d write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
419 !d &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
426 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
427 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
428 !d write (iout,*) "multibody_hb ecorr",ecorr
431 ! print *,"Processor",myrank," computed Ucorr"
433 ! If performing constraint dynamics, call the constraint energy
434 ! after the equilibration time
435 if(usampl.and.totT.gt.eq_time) then
444 time_enecalc=time_enecalc+MPI_Wtime()-time00
446 ! print *,"Processor",myrank," computed Uconstr"
455 energia(2)=evdw2-evdw2_14
472 energia(8)=eello_turn3
473 energia(9)=eello_turn4
480 energia(19)=edihcnstr
482 energia(20)=Uconst+Uconst_back
484 ! Here are the energies showed per procesor if the are more processors
485 ! per molecule then we sum it up in sum_energy subroutine
486 ! print *," Processor",myrank," calls SUM_ENERGY"
487 call sum_energy(energia,.true.)
488 if (dyn_ss) call dyn_set_nss
489 ! print *," Processor",myrank," left SUM_ENERGY"
491 time_sumene=time_sumene+MPI_Wtime()-time00
494 end subroutine etotal
495 !-----------------------------------------------------------------------------
496 subroutine sum_energy(energia,reduce)
497 ! implicit real*8 (a-h,o-z)
498 ! include 'DIMENSIONS'
502 !MS$ATTRIBUTES C :: proc_proc
508 ! include 'COMMON.SETUP'
509 ! include 'COMMON.IOUNITS'
510 real(kind=8) :: energia(0:n_ene),enebuff(0:n_ene+1)
511 ! include 'COMMON.FFIELD'
512 ! include 'COMMON.DERIV'
513 ! include 'COMMON.INTERACT'
514 ! include 'COMMON.SBRIDGE'
515 ! include 'COMMON.CHAIN'
516 ! include 'COMMON.VAR'
517 ! include 'COMMON.CONTROL'
518 ! include 'COMMON.TIME1'
520 real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
521 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
522 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot
526 real(kind=8) :: time00
527 if (nfgtasks.gt.1 .and. reduce) then
530 write (iout,*) "energies before REDUCE"
531 call enerprint(energia)
535 enebuff(i)=energia(i)
538 call MPI_Barrier(FG_COMM,IERR)
539 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
541 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,&
542 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
544 write (iout,*) "energies after REDUCE"
545 call enerprint(energia)
548 time_Reduce=time_Reduce+MPI_Wtime()-time00
550 if (fg_rank.eq.0) then
554 evdw2=energia(2)+energia(18)
570 eello_turn3=energia(8)
571 eello_turn4=energia(9)
578 edihcnstr=energia(19)
583 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
584 +wang*ebe+wtor*etors+wscloc*escloc &
585 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
586 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
587 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
588 +wbond*estr+Uconst+wsccor*esccor
590 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
591 +wang*ebe+wtor*etors+wscloc*escloc &
592 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
593 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
594 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
595 +wbond*estr+Uconst+wsccor*esccor
601 if (isnan(etot).ne.0) energia(0)=1.0d+99
603 if (isnan(etot)) energia(0)=1.0d+99
608 idumm=proc_proc(etot,i)
610 call proc_proc(etot,i)
612 if(i.eq.1)energia(0)=1.0d+99
620 end subroutine sum_energy
621 !-----------------------------------------------------------------------------
622 subroutine rescale_weights(t_bath)
623 ! implicit real*8 (a-h,o-z)
627 ! include 'DIMENSIONS'
628 ! include 'COMMON.IOUNITS'
629 ! include 'COMMON.FFIELD'
630 ! include 'COMMON.SBRIDGE'
631 real(kind=8) :: kfac=2.4d0
632 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644
634 real(kind=8) :: t_bath,facT,facT2,facT3,facT4,facT5
637 ! facT=2*temp0/(t_bath+temp0)
638 if (rescale_mode.eq.0) then
644 else if (rescale_mode.eq.1) then
645 facT=kfac/(kfac-1.0d0+t_bath/temp0)
646 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
647 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
648 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
649 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
650 else if (rescale_mode.eq.2) then
656 facT=licznik/dlog(dexp(x)+dexp(-x))
657 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
658 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
659 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
660 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
662 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
663 write (*,*) "Wrong RESCALE_MODE",rescale_mode
665 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
669 welec=weights(3)*fact
670 wcorr=weights(4)*fact3
671 wcorr5=weights(5)*fact4
672 wcorr6=weights(6)*fact5
673 wel_loc=weights(7)*fact2
674 wturn3=weights(8)*fact2
675 wturn4=weights(9)*fact3
676 wturn6=weights(10)*fact5
677 wtor=weights(13)*fact
678 wtor_d=weights(14)*fact2
679 wsccor=weights(21)*fact
682 end subroutine rescale_weights
683 !-----------------------------------------------------------------------------
684 subroutine enerprint(energia)
685 ! implicit real*8 (a-h,o-z)
686 ! include 'DIMENSIONS'
687 ! include 'COMMON.IOUNITS'
688 ! include 'COMMON.FFIELD'
689 ! include 'COMMON.SBRIDGE'
690 ! include 'COMMON.MD'
691 real(kind=8) :: energia(0:n_ene)
693 real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
694 real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
695 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor
701 evdw2=energia(2)+energia(18)
713 eello_turn3=energia(8)
714 eello_turn4=energia(9)
715 eello_turn6=energia(10)
721 edihcnstr=energia(19)
726 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
727 estr,wbond,ebe,wang,&
728 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
730 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
731 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,&
734 10 format (/'Virtual-chain energies:'// &
735 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
736 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
737 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
738 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ &
739 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
740 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
741 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
742 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
743 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
744 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
745 ' (SS bridges & dist. cnstr.)'/ &
746 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
747 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
748 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
749 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
750 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
751 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
752 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
753 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
754 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
755 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
756 'UCONST= ',1pE16.6,' (Constraint energy)'/ &
757 'ETOT= ',1pE16.6,' (total)')
759 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
760 estr,wbond,ebe,wang,&
761 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
763 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
764 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
766 10 format (/'Virtual-chain energies:'// &
767 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
768 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
769 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
770 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
771 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
772 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
773 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
774 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
775 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
776 ' (SS bridges & dist. cnstr.)'/ &
777 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
778 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
779 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
780 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
781 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
782 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
783 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
784 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
785 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
786 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
787 'UCONST=',1pE16.6,' (Constraint energy)'/ &
788 'ETOT= ',1pE16.6,' (total)')
791 end subroutine enerprint
792 !-----------------------------------------------------------------------------
795 ! This subroutine calculates the interaction energy of nonbonded side chains
796 ! assuming the LJ potential of interaction.
798 ! implicit real*8 (a-h,o-z)
799 ! include 'DIMENSIONS'
800 real(kind=8),parameter :: accur=1.0d-10
801 ! include 'COMMON.GEO'
802 ! include 'COMMON.VAR'
803 ! include 'COMMON.LOCAL'
804 ! include 'COMMON.CHAIN'
805 ! include 'COMMON.DERIV'
806 ! include 'COMMON.INTERACT'
807 ! include 'COMMON.TORSION'
808 ! include 'COMMON.SBRIDGE'
809 ! include 'COMMON.NAMES'
810 ! include 'COMMON.IOUNITS'
811 ! include 'COMMON.CONTACTS'
812 real(kind=8),dimension(3) :: gg
815 integer :: i,itypi,iint,j,itypi1,itypj,k
816 real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
817 real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
818 real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
820 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
822 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
823 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
824 ! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
825 ! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
829 if (itypi.eq.ntyp1) cycle
830 itypi1=iabs(itype(i+1))
837 ! Calculate SC interaction energy.
840 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
841 !d & 'iend=',iend(i,iint)
842 do j=istart(i,iint),iend(i,iint)
844 if (itypj.eq.ntyp1) cycle
848 ! Change 12/1/95 to calculate four-body interactions
849 rij=xj*xj+yj*yj+zj*zj
851 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
852 eps0ij=eps(itypi,itypj)
854 e1=fac*fac*aa(itypi,itypj)
855 e2=fac*bb(itypi,itypj)
857 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
858 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
859 !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
860 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
861 !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
862 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
865 ! Calculate the components of the gradient in DC and X
867 fac=-rrij*(e1+evdwij)
872 gvdwx(k,i)=gvdwx(k,i)-gg(k)
873 gvdwx(k,j)=gvdwx(k,j)+gg(k)
874 gvdwc(k,i)=gvdwc(k,i)-gg(k)
875 gvdwc(k,j)=gvdwc(k,j)+gg(k)
879 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
883 ! 12/1/95, revised on 5/20/97
885 ! Calculate the contact function. The ith column of the array JCONT will
886 ! contain the numbers of atoms that make contacts with the atom I (of numbers
887 ! greater than I). The arrays FACONT and GACONT will contain the values of
888 ! the contact function and its derivative.
890 ! Uncomment next line, if the correlation interactions include EVDW explicitly.
891 ! if (j.gt.i+1 .and. evdwij.le.0.0D0) then
892 ! Uncomment next line, if the correlation interactions are contact function only
893 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
895 sigij=sigma(itypi,itypj)
896 r0ij=rs0(itypi,itypj)
898 ! Check whether the SC's are not too far to make a contact.
901 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
902 ! Add a new contact, if the SC's are close enough, but not too close (r<sigma).
904 if (fcont.gt.0.0D0) then
905 ! If the SC-SC distance if close to sigma, apply spline.
906 !Adam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
907 !Adam & fcont1,fprimcont1)
908 !Adam fcont1=1.0d0-fcont1
909 !Adam if (fcont1.gt.0.0d0) then
910 !Adam fprimcont=fprimcont*fcont1+fcont*fprimcont1
911 !Adam fcont=fcont*fcont1
913 ! Uncomment following 4 lines to have the geometric average of the epsilon0's
914 !ga eps0ij=1.0d0/dsqrt(eps0ij)
916 !ga gg(k)=gg(k)*eps0ij
918 !ga eps0ij=-evdwij*eps0ij
919 ! Uncomment for AL's type of SC correlation interactions.
921 num_conti=num_conti+1
923 facont(num_conti,i)=fcont*eps0ij
924 fprimcont=eps0ij*fprimcont/rij
926 !Adam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
927 !Adam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
928 !Adam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
929 ! Uncomment following 3 lines for Skolnick's type of SC correlation.
930 gacont(1,num_conti,i)=-fprimcont*xj
931 gacont(2,num_conti,i)=-fprimcont*yj
932 gacont(3,num_conti,i)=-fprimcont*zj
933 !d write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
934 !d write (iout,'(2i3,3f10.5)')
935 !d & i,j,(gacont(kk,num_conti,i),kk=1,3)
941 num_cont(i)=num_conti
945 gvdwc(j,i)=expon*gvdwc(j,i)
946 gvdwx(j,i)=expon*gvdwx(j,i)
949 !******************************************************************************
953 ! To save time, the factor of EXPON has been extracted from ALL components
954 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
957 !******************************************************************************
960 !-----------------------------------------------------------------------------
961 subroutine eljk(evdw)
963 ! This subroutine calculates the interaction energy of nonbonded side chains
964 ! assuming the LJK potential of interaction.
966 ! implicit real*8 (a-h,o-z)
967 ! include 'DIMENSIONS'
968 ! include 'COMMON.GEO'
969 ! include 'COMMON.VAR'
970 ! include 'COMMON.LOCAL'
971 ! include 'COMMON.CHAIN'
972 ! include 'COMMON.DERIV'
973 ! include 'COMMON.INTERACT'
974 ! include 'COMMON.IOUNITS'
975 ! include 'COMMON.NAMES'
976 real(kind=8),dimension(3) :: gg
979 integer :: i,iint,j,itypi,itypi1,k,itypj
980 real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
981 real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
983 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
987 if (itypi.eq.ntyp1) cycle
988 itypi1=iabs(itype(i+1))
993 ! Calculate SC interaction energy.
996 do j=istart(i,iint),iend(i,iint)
998 if (itypj.eq.ntyp1) cycle
1002 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1003 fac_augm=rrij**expon
1004 e_augm=augm(itypi,itypj)*fac_augm
1005 r_inv_ij=dsqrt(rrij)
1007 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1008 fac=r_shift_inv**expon
1009 e1=fac*fac*aa(itypi,itypj)
1010 e2=fac*bb(itypi,itypj)
1012 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1013 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1014 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1015 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1016 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1017 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1018 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1021 ! Calculate the components of the gradient in DC and X
1023 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1028 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1029 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1030 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1031 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1035 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1043 gvdwc(j,i)=expon*gvdwc(j,i)
1044 gvdwx(j,i)=expon*gvdwx(j,i)
1049 !-----------------------------------------------------------------------------
1050 subroutine ebp(evdw)
1052 ! This subroutine calculates the interaction energy of nonbonded side chains
1053 ! assuming the Berne-Pechukas potential of interaction.
1057 ! implicit real*8 (a-h,o-z)
1058 ! include 'DIMENSIONS'
1059 ! include 'COMMON.GEO'
1060 ! include 'COMMON.VAR'
1061 ! include 'COMMON.LOCAL'
1062 ! include 'COMMON.CHAIN'
1063 ! include 'COMMON.DERIV'
1064 ! include 'COMMON.NAMES'
1065 ! include 'COMMON.INTERACT'
1066 ! include 'COMMON.IOUNITS'
1067 ! include 'COMMON.CALC'
1069 !el integer :: icall
1070 !el common /srutu/ icall
1071 ! double precision rrsave(maxdim)
1074 integer :: iint,itypi,itypi1,itypj
1075 real(kind=8) :: rrij,xi,yi,zi
1076 real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
1078 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1080 ! if (icall.eq.0) then
1086 do i=iatsc_s,iatsc_e
1087 itypi=iabs(itype(i))
1088 if (itypi.eq.ntyp1) cycle
1089 itypi1=iabs(itype(i+1))
1093 dxi=dc_norm(1,nres+i)
1094 dyi=dc_norm(2,nres+i)
1095 dzi=dc_norm(3,nres+i)
1096 ! dsci_inv=dsc_inv(itypi)
1097 dsci_inv=vbld_inv(i+nres)
1099 ! Calculate SC interaction energy.
1101 do iint=1,nint_gr(i)
1102 do j=istart(i,iint),iend(i,iint)
1104 itypj=iabs(itype(j))
1105 if (itypj.eq.ntyp1) cycle
1106 ! dscj_inv=dsc_inv(itypj)
1107 dscj_inv=vbld_inv(j+nres)
1108 chi1=chi(itypi,itypj)
1109 chi2=chi(itypj,itypi)
1116 alf12=0.5D0*(alf1+alf2)
1117 ! For diagnostics only!!!
1130 dxj=dc_norm(1,nres+j)
1131 dyj=dc_norm(2,nres+j)
1132 dzj=dc_norm(3,nres+j)
1133 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1134 !d if (icall.eq.0) then
1140 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
1142 ! Calculate whole angle-dependent part of epsilon and contributions
1143 ! to its derivatives
1144 fac=(rrij*sigsq)**expon2
1145 e1=fac*fac*aa(itypi,itypj)
1146 e2=fac*bb(itypi,itypj)
1147 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1148 eps2der=evdwij*eps3rt
1149 eps3der=evdwij*eps2rt
1150 evdwij=evdwij*eps2rt*eps3rt
1153 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1154 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1155 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1156 !d & restyp(itypi),i,restyp(itypj),j,
1157 !d & epsi,sigm,chi1,chi2,chip1,chip2,
1158 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1159 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
1162 ! Calculate gradient components.
1163 e1=e1*eps1*eps2rt**2*eps3rt**2
1164 fac=-expon*(e1+evdwij)
1167 ! Calculate radial part of the gradient
1171 ! Calculate the angular part of the gradient and sum add the contributions
1172 ! to the appropriate components of the Cartesian gradient.
1180 !-----------------------------------------------------------------------------
1181 subroutine egb(evdw)
1183 ! This subroutine calculates the interaction energy of nonbonded side chains
1184 ! assuming the Gay-Berne potential of interaction.
1187 ! implicit real*8 (a-h,o-z)
1188 ! include 'DIMENSIONS'
1189 ! include 'COMMON.GEO'
1190 ! include 'COMMON.VAR'
1191 ! include 'COMMON.LOCAL'
1192 ! include 'COMMON.CHAIN'
1193 ! include 'COMMON.DERIV'
1194 ! include 'COMMON.NAMES'
1195 ! include 'COMMON.INTERACT'
1196 ! include 'COMMON.IOUNITS'
1197 ! include 'COMMON.CALC'
1198 ! include 'COMMON.CONTROL'
1199 ! include 'COMMON.SBRIDGE'
1202 integer :: iint,itypi,itypi1,itypj
1203 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
1204 real(kind=8) :: evdw,sig0ij
1206 !cccc energy_dec=.false.
1207 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1210 ! if (icall.eq.0) lprn=.false.
1212 do i=iatsc_s,iatsc_e
1213 itypi=iabs(itype(i))
1214 if (itypi.eq.ntyp1) cycle
1215 itypi1=iabs(itype(i+1))
1219 dxi=dc_norm(1,nres+i)
1220 dyi=dc_norm(2,nres+i)
1221 dzi=dc_norm(3,nres+i)
1222 ! dsci_inv=dsc_inv(itypi)
1223 dsci_inv=vbld_inv(i+nres)
1224 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1225 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1227 ! Calculate SC interaction energy.
1229 do iint=1,nint_gr(i)
1230 do j=istart(i,iint),iend(i,iint)
1231 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1232 call dyn_ssbond_ene(i,j,evdwij)
1234 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1235 'evdw',i,j,evdwij,' ss'
1238 itypj=iabs(itype(j))
1239 if (itypj.eq.ntyp1) cycle
1240 ! dscj_inv=dsc_inv(itypj)
1241 dscj_inv=vbld_inv(j+nres)
1242 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1243 ! & 1.0d0/vbld(j+nres)
1244 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1245 sig0ij=sigma(itypi,itypj)
1246 chi1=chi(itypi,itypj)
1247 chi2=chi(itypj,itypi)
1254 alf12=0.5D0*(alf1+alf2)
1255 ! For diagnostics only!!!
1268 dxj=dc_norm(1,nres+j)
1269 dyj=dc_norm(2,nres+j)
1270 dzj=dc_norm(3,nres+j)
1271 ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1272 ! write (iout,*) "j",j," dc_norm",
1273 ! & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1274 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1276 ! Calculate angle-dependent terms of energy and contributions to their
1280 sig=sig0ij*dsqrt(sigsq)
1281 rij_shift=1.0D0/rij-sig+sig0ij
1282 ! for diagnostics; uncomment
1283 ! rij_shift=1.2*sig0ij
1284 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1285 if (rij_shift.le.0.0D0) then
1287 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1288 !d & restyp(itypi),i,restyp(itypj),j,
1289 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1293 !---------------------------------------------------------------
1294 rij_shift=1.0D0/rij_shift
1295 fac=rij_shift**expon
1296 e1=fac*fac*aa(itypi,itypj)
1297 e2=fac*bb(itypi,itypj)
1298 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1299 eps2der=evdwij*eps3rt
1300 eps3der=evdwij*eps2rt
1301 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,&
1302 ! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1303 evdwij=evdwij*eps2rt*eps3rt
1306 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1307 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1308 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1309 restyp(itypi),i,restyp(itypj),j, &
1310 epsi,sigm,chi1,chi2,chip1,chip2, &
1311 eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
1312 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
1316 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
1319 ! Calculate gradient components.
1320 e1=e1*eps1*eps2rt**2*eps3rt**2
1321 fac=-expon*(e1+evdwij)*rij_shift
1325 ! Calculate the radial part of the gradient
1329 ! Calculate angular part of the gradient.
1335 ! write (iout,*) "Number of loop steps in EGB:",ind
1336 !ccc energy_dec=.false.
1339 !-----------------------------------------------------------------------------
1340 subroutine egbv(evdw)
1342 ! This subroutine calculates the interaction energy of nonbonded side chains
1343 ! assuming the Gay-Berne-Vorobjev potential of interaction.
1347 ! implicit real*8 (a-h,o-z)
1348 ! include 'DIMENSIONS'
1349 ! include 'COMMON.GEO'
1350 ! include 'COMMON.VAR'
1351 ! include 'COMMON.LOCAL'
1352 ! include 'COMMON.CHAIN'
1353 ! include 'COMMON.DERIV'
1354 ! include 'COMMON.NAMES'
1355 ! include 'COMMON.INTERACT'
1356 ! include 'COMMON.IOUNITS'
1357 ! include 'COMMON.CALC'
1359 !el integer :: icall
1360 !el common /srutu/ icall
1363 integer :: iint,itypi,itypi1,itypj
1364 real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
1365 real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
1367 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1370 ! if (icall.eq.0) lprn=.true.
1372 do i=iatsc_s,iatsc_e
1373 itypi=iabs(itype(i))
1374 if (itypi.eq.ntyp1) cycle
1375 itypi1=iabs(itype(i+1))
1379 dxi=dc_norm(1,nres+i)
1380 dyi=dc_norm(2,nres+i)
1381 dzi=dc_norm(3,nres+i)
1382 ! dsci_inv=dsc_inv(itypi)
1383 dsci_inv=vbld_inv(i+nres)
1385 ! Calculate SC interaction energy.
1387 do iint=1,nint_gr(i)
1388 do j=istart(i,iint),iend(i,iint)
1390 itypj=iabs(itype(j))
1391 if (itypj.eq.ntyp1) cycle
1392 ! dscj_inv=dsc_inv(itypj)
1393 dscj_inv=vbld_inv(j+nres)
1394 sig0ij=sigma(itypi,itypj)
1395 r0ij=r0(itypi,itypj)
1396 chi1=chi(itypi,itypj)
1397 chi2=chi(itypj,itypi)
1404 alf12=0.5D0*(alf1+alf2)
1405 ! For diagnostics only!!!
1418 dxj=dc_norm(1,nres+j)
1419 dyj=dc_norm(2,nres+j)
1420 dzj=dc_norm(3,nres+j)
1421 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1423 ! Calculate angle-dependent terms of energy and contributions to their
1427 sig=sig0ij*dsqrt(sigsq)
1428 rij_shift=1.0D0/rij-sig+r0ij
1429 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1430 if (rij_shift.le.0.0D0) then
1435 !---------------------------------------------------------------
1436 rij_shift=1.0D0/rij_shift
1437 fac=rij_shift**expon
1438 e1=fac*fac*aa(itypi,itypj)
1439 e2=fac*bb(itypi,itypj)
1440 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1441 eps2der=evdwij*eps3rt
1442 eps3der=evdwij*eps2rt
1443 fac_augm=rrij**expon
1444 e_augm=augm(itypi,itypj)*fac_augm
1445 evdwij=evdwij*eps2rt*eps3rt
1446 evdw=evdw+evdwij+e_augm
1448 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1449 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1450 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1451 restyp(itypi),i,restyp(itypj),j,&
1452 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
1453 chi1,chi2,chip1,chip2,&
1454 eps1,eps2rt**2,eps3rt**2,&
1455 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
1458 ! Calculate gradient components.
1459 e1=e1*eps1*eps2rt**2*eps3rt**2
1460 fac=-expon*(e1+evdwij)*rij_shift
1462 fac=rij*fac-2*expon*rrij*e_augm
1463 ! Calculate the radial part of the gradient
1467 ! Calculate angular part of the gradient.
1473 !-----------------------------------------------------------------------------
1474 !el subroutine sc_angular in module geometry
1475 !-----------------------------------------------------------------------------
1476 subroutine e_softsphere(evdw)
1478 ! This subroutine calculates the interaction energy of nonbonded side chains
1479 ! assuming the LJ potential of interaction.
1481 ! implicit real*8 (a-h,o-z)
1482 ! include 'DIMENSIONS'
1483 real(kind=8),parameter :: accur=1.0d-10
1484 ! include 'COMMON.GEO'
1485 ! include 'COMMON.VAR'
1486 ! include 'COMMON.LOCAL'
1487 ! include 'COMMON.CHAIN'
1488 ! include 'COMMON.DERIV'
1489 ! include 'COMMON.INTERACT'
1490 ! include 'COMMON.TORSION'
1491 ! include 'COMMON.SBRIDGE'
1492 ! include 'COMMON.NAMES'
1493 ! include 'COMMON.IOUNITS'
1494 ! include 'COMMON.CONTACTS'
1495 real(kind=8),dimension(3) :: gg
1496 !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1498 integer :: i,iint,j,itypi,itypi1,itypj,k
1499 real(kind=8) :: evdw,xj,yj,zj,xi,yi,zi,rij,r0ij,r0ijsq,evdwij
1503 do i=iatsc_s,iatsc_e
1504 itypi=iabs(itype(i))
1505 if (itypi.eq.ntyp1) cycle
1506 itypi1=iabs(itype(i+1))
1511 ! Calculate SC interaction energy.
1513 do iint=1,nint_gr(i)
1514 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1515 !d & 'iend=',iend(i,iint)
1516 do j=istart(i,iint),iend(i,iint)
1517 itypj=iabs(itype(j))
1518 if (itypj.eq.ntyp1) cycle
1522 rij=xj*xj+yj*yj+zj*zj
1523 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1524 r0ij=r0(itypi,itypj)
1526 ! print *,i,j,r0ij,dsqrt(rij)
1527 if (rij.lt.r0ijsq) then
1528 evdwij=0.25d0*(rij-r0ijsq)**2
1536 ! Calculate the components of the gradient in DC and X
1542 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1543 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1544 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1545 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1549 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1556 end subroutine e_softsphere
1557 !-----------------------------------------------------------------------------
1558 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1560 ! Soft-sphere potential of p-p interaction
1562 ! implicit real*8 (a-h,o-z)
1563 ! include 'DIMENSIONS'
1564 ! include 'COMMON.CONTROL'
1565 ! include 'COMMON.IOUNITS'
1566 ! include 'COMMON.GEO'
1567 ! include 'COMMON.VAR'
1568 ! include 'COMMON.LOCAL'
1569 ! include 'COMMON.CHAIN'
1570 ! include 'COMMON.DERIV'
1571 ! include 'COMMON.INTERACT'
1572 ! include 'COMMON.CONTACTS'
1573 ! include 'COMMON.TORSION'
1574 ! include 'COMMON.VECTORS'
1575 ! include 'COMMON.FFIELD'
1576 real(kind=8),dimension(3) :: ggg
1577 !d write(iout,*) 'In EELEC_soft_sphere'
1579 integer :: i,j,k,num_conti,iteli,itelj
1580 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
1581 real(kind=8) :: dxi,dyi,dzi,xmedi,ymedi,zmedi,r0ij,r0ijsq
1582 real(kind=8) :: dxj,dyj,dzj,xj,yj,zj,rij,evdw1ij,fac
1590 do i=iatel_s,iatel_e
1591 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1595 xmedi=c(1,i)+0.5d0*dxi
1596 ymedi=c(2,i)+0.5d0*dyi
1597 zmedi=c(3,i)+0.5d0*dzi
1599 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1600 do j=ielstart(i),ielend(i)
1601 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1605 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1606 r0ij=rpp(iteli,itelj)
1611 xj=c(1,j)+0.5D0*dxj-xmedi
1612 yj=c(2,j)+0.5D0*dyj-ymedi
1613 zj=c(3,j)+0.5D0*dzj-zmedi
1614 rij=xj*xj+yj*yj+zj*zj
1615 if (rij.lt.r0ijsq) then
1616 evdw1ij=0.25d0*(rij-r0ijsq)**2
1624 ! Calculate contributions to the Cartesian gradient.
1630 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1631 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1634 ! Loop over residues i+1 thru j-1.
1638 !grad gelc(l,k)=gelc(l,k)+ggg(l)
1643 !grad do i=nnt,nct-1
1645 !grad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1647 !grad do j=i+1,nct-1
1649 !grad gelc(k,i)=gelc(k,i)+gelc(k,j)
1654 end subroutine eelec_soft_sphere
1655 !-----------------------------------------------------------------------------
1656 subroutine vec_and_deriv
1657 ! implicit real*8 (a-h,o-z)
1658 ! include 'DIMENSIONS'
1662 ! include 'COMMON.IOUNITS'
1663 ! include 'COMMON.GEO'
1664 ! include 'COMMON.VAR'
1665 ! include 'COMMON.LOCAL'
1666 ! include 'COMMON.CHAIN'
1667 ! include 'COMMON.VECTORS'
1668 ! include 'COMMON.SETUP'
1669 ! include 'COMMON.TIME1'
1670 real(kind=8),dimension(3,3,2) :: uyder,uzder
1671 real(kind=8),dimension(2) :: vbld_inv_temp
1672 ! Compute the local reference systems. For reference system (i), the
1673 ! X-axis points from CA(i) to CA(i+1), the Y axis is in the
1674 ! CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1677 real(kind=8) :: facy,fac,costh
1680 do i=ivec_start,ivec_end
1684 if (i.eq.nres-1) then
1685 ! Case of the last full residue
1686 ! Compute the Z-axis
1687 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1688 costh=dcos(pi-theta(nres))
1689 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1693 ! Compute the derivatives of uz
1695 uzder(2,1,1)=-dc_norm(3,i-1)
1696 uzder(3,1,1)= dc_norm(2,i-1)
1697 uzder(1,2,1)= dc_norm(3,i-1)
1699 uzder(3,2,1)=-dc_norm(1,i-1)
1700 uzder(1,3,1)=-dc_norm(2,i-1)
1701 uzder(2,3,1)= dc_norm(1,i-1)
1704 uzder(2,1,2)= dc_norm(3,i)
1705 uzder(3,1,2)=-dc_norm(2,i)
1706 uzder(1,2,2)=-dc_norm(3,i)
1708 uzder(3,2,2)= dc_norm(1,i)
1709 uzder(1,3,2)= dc_norm(2,i)
1710 uzder(2,3,2)=-dc_norm(1,i)
1712 ! Compute the Y-axis
1715 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1717 ! Compute the derivatives of uy
1720 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) &
1721 -dc_norm(k,i)*dc_norm(j,i-1)
1722 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1724 uyder(j,j,1)=uyder(j,j,1)-costh
1725 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1730 uygrad(l,k,j,i)=uyder(l,k,j)
1731 uzgrad(l,k,j,i)=uzder(l,k,j)
1735 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1736 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1737 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1738 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1741 ! Compute the Z-axis
1742 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1743 costh=dcos(pi-theta(i+2))
1744 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1748 ! Compute the derivatives of uz
1750 uzder(2,1,1)=-dc_norm(3,i+1)
1751 uzder(3,1,1)= dc_norm(2,i+1)
1752 uzder(1,2,1)= dc_norm(3,i+1)
1754 uzder(3,2,1)=-dc_norm(1,i+1)
1755 uzder(1,3,1)=-dc_norm(2,i+1)
1756 uzder(2,3,1)= dc_norm(1,i+1)
1759 uzder(2,1,2)= dc_norm(3,i)
1760 uzder(3,1,2)=-dc_norm(2,i)
1761 uzder(1,2,2)=-dc_norm(3,i)
1763 uzder(3,2,2)= dc_norm(1,i)
1764 uzder(1,3,2)= dc_norm(2,i)
1765 uzder(2,3,2)=-dc_norm(1,i)
1767 ! Compute the Y-axis
1770 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1772 ! Compute the derivatives of uy
1775 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) &
1776 -dc_norm(k,i)*dc_norm(j,i+1)
1777 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1779 uyder(j,j,1)=uyder(j,j,1)-costh
1780 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1785 uygrad(l,k,j,i)=uyder(l,k,j)
1786 uzgrad(l,k,j,i)=uzder(l,k,j)
1790 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1791 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1792 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1793 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1797 vbld_inv_temp(1)=vbld_inv(i+1)
1798 if (i.lt.nres-1) then
1799 vbld_inv_temp(2)=vbld_inv(i+2)
1801 vbld_inv_temp(2)=vbld_inv(i)
1806 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1807 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1812 #if defined(PARVEC) && defined(MPI)
1813 if (nfgtasks1.gt.1) then
1815 ! print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
1816 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
1817 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
1818 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),&
1819 MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
1821 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),&
1822 MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
1824 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),&
1825 ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),&
1826 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
1827 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),&
1828 ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),&
1829 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
1830 time_gather=time_gather+MPI_Wtime()-time00
1832 ! if (fg_rank.eq.0) then
1833 ! write (iout,*) "Arrays UY and UZ"
1835 ! write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
1841 end subroutine vec_and_deriv
1842 !-----------------------------------------------------------------------------
1843 subroutine check_vecgrad
1844 ! implicit real*8 (a-h,o-z)
1845 ! include 'DIMENSIONS'
1846 ! include 'COMMON.IOUNITS'
1847 ! include 'COMMON.GEO'
1848 ! include 'COMMON.VAR'
1849 ! include 'COMMON.LOCAL'
1850 ! include 'COMMON.CHAIN'
1851 ! include 'COMMON.VECTORS'
1852 real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
1853 real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
1854 real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
1855 real(kind=8),dimension(3) :: erij
1856 real(kind=8) :: delta=1.0d-7
1862 !rc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1863 !rc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1864 !rc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1865 !d write(iout,'(2i5,2(3f10.5,5x))') i,1,
1866 !d & (dc_norm(if90,i),if90=1,3)
1867 !d write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1868 !d write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1869 !d write(iout,'(a)')
1875 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1876 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1889 !d write (iout,*) 'i=',i
1891 erij(k)=dc_norm(k,i)
1895 dc_norm(k,i)=erij(k)
1897 dc_norm(j,i)=dc_norm(j,i)+delta
1898 ! fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1900 ! dc_norm(k,i)=dc_norm(k,i)/fac
1902 ! write (iout,*) (dc_norm(k,i),k=1,3)
1903 ! write (iout,*) (erij(k),k=1,3)
1906 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1907 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1908 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1909 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1911 ! write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1912 ! & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1913 ! & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1916 dc_norm(k,i)=erij(k)
1919 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1920 !d & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1921 !d & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1922 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1923 !d & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1924 !d & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1925 !d write (iout,'(a)')
1929 end subroutine check_vecgrad
1930 !-----------------------------------------------------------------------------
1931 subroutine set_matrices
1932 ! implicit real*8 (a-h,o-z)
1933 ! include 'DIMENSIONS'
1936 ! include "COMMON.SETUP"
1938 integer :: status(MPI_STATUS_SIZE)
1940 ! include 'COMMON.IOUNITS'
1941 ! include 'COMMON.GEO'
1942 ! include 'COMMON.VAR'
1943 ! include 'COMMON.LOCAL'
1944 ! include 'COMMON.CHAIN'
1945 ! include 'COMMON.DERIV'
1946 ! include 'COMMON.INTERACT'
1947 ! include 'COMMON.CONTACTS'
1948 ! include 'COMMON.TORSION'
1949 ! include 'COMMON.VECTORS'
1950 ! include 'COMMON.FFIELD'
1951 real(kind=8) :: auxvec(2),auxmat(2,2)
1952 integer :: i,iti1,iti,k,l
1953 real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2
1955 ! allocate(Ug(2,2,nres)) !(2,2,maxres)
1956 ! allocate(Ug2(2,2,nres)) !(2,2,maxres)
1957 ! allocate(Ugder(2,2,nres)) !(2,2,maxres)
1958 ! allocate(Ug2der(2,2,nres)) !(2,2,maxres)
1959 ! allocate(obrot(2,nres)) !(2,maxres)
1960 ! allocate(obrot2(2,nres)) !(2,maxres)
1961 ! allocate(obrot_der(2,nres)) !(2,maxres)
1962 ! allocate(obrot2_der(2,nres)) !(2,maxres)
1963 ! allocate(costab2(nres)) !(maxres)
1964 ! allocate(sintab2(nres)) !(maxres)
1965 ! allocate(costab(nres)) !(maxres)
1966 ! allocate(sintab(nres)) !(maxres)
1968 ! allocate(Ub2(2,nres)) !(2,maxres)
1969 ! allocate(Ctobr(2,nres)) !(2,maxres)
1970 ! allocate(Dtobr2(2,nres)) !(2,maxres)
1971 ! allocate(mu(2,nres)) !(2,maxres)
1972 ! allocate(muder(2,nres)) !(2,maxres)
1973 ! allocate(Ub2der(2,nres)) !(2,maxres)
1974 ! allocate(Ctobrder(2,nres)) !(2,maxres)
1975 ! allocate(Dtobr2der(2,nres)) !(2,maxres)
1977 ! allocate(EUg(2,2,nres)) !(2,2,maxres)
1978 ! allocate(CUg(2,2,nres)) !(2,2,maxres)
1979 ! allocate(DUg(2,2,nres)) !(2,2,maxres)
1980 ! allocate(DtUg2(2,2,nres)) !(2,2,maxres)
1981 ! allocate(EUgder(2,2,nres)) !(2,2,maxres)
1982 ! allocate(CUgder(2,2,nres)) !(2,2,maxres)
1983 ! allocate(DUgder(2,2,nres)) !(2,2,maxres)
1984 ! allocate(Dtug2der(2,2,nres)) !(2,2,maxres)
1986 ! allocate(Ug2Db1t(2,nres)) !(2,maxres)
1987 ! allocate(Ug2Db1tder(2,nres)) !(2,maxres)
1988 ! allocate(CUgb2(2,nres)) !(2,maxres)
1989 ! allocate(CUgb2der(2,nres)) !(2,maxres)
1991 ! allocate(EUgC(2,2,nres)) !(2,2,maxres)
1992 ! allocate(EUgCder(2,2,nres)) !(2,2,maxres)
1993 ! allocate(EUgD(2,2,nres)) !(2,2,maxres)
1994 ! allocate(EUgDder(2,2,nres)) !(2,2,maxres)
1995 ! allocate(DtUg2EUg(2,2,nres)) !(2,2,maxres)
1996 ! allocate(Ug2DtEUg(2,2,nres)) !(2,2,maxres)
1998 ! allocate(Ug2DtEUgder(2,2,2,nres)) !(2,2,2,maxres)
1999 ! allocate(DtUg2EUgder(2,2,2,nres)) !(2,2,2,maxres)
2002 ! Compute the virtual-bond-torsional-angle dependent quantities needed
2003 ! to calculate the el-loc multibody terms of various order.
2006 do i=ivec_start+2,ivec_end+2
2010 if (i .lt. nres+1) then
2047 if (i .gt. 3 .and. i .lt. nres+1) then
2048 obrot_der(1,i-2)=-sin1
2049 obrot_der(2,i-2)= cos1
2050 Ugder(1,1,i-2)= sin1
2051 Ugder(1,2,i-2)=-cos1
2052 Ugder(2,1,i-2)=-cos1
2053 Ugder(2,2,i-2)=-sin1
2056 obrot2_der(1,i-2)=-dwasin2
2057 obrot2_der(2,i-2)= dwacos2
2058 Ug2der(1,1,i-2)= dwasin2
2059 Ug2der(1,2,i-2)=-dwacos2
2060 Ug2der(2,1,i-2)=-dwacos2
2061 Ug2der(2,2,i-2)=-dwasin2
2063 obrot_der(1,i-2)=0.0d0
2064 obrot_der(2,i-2)=0.0d0
2065 Ugder(1,1,i-2)=0.0d0
2066 Ugder(1,2,i-2)=0.0d0
2067 Ugder(2,1,i-2)=0.0d0
2068 Ugder(2,2,i-2)=0.0d0
2069 obrot2_der(1,i-2)=0.0d0
2070 obrot2_der(2,i-2)=0.0d0
2071 Ug2der(1,1,i-2)=0.0d0
2072 Ug2der(1,2,i-2)=0.0d0
2073 Ug2der(2,1,i-2)=0.0d0
2074 Ug2der(2,2,i-2)=0.0d0
2076 ! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2077 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2078 iti = itortyp(itype(i-2))
2082 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2083 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2084 iti1 = itortyp(itype(i-1))
2088 !d write (iout,*) '*******i',i,' iti1',iti
2089 !d write (iout,*) 'b1',b1(:,iti)
2090 !d write (iout,*) 'b2',b2(:,iti)
2091 !d write (iout,*) 'Ug',Ug(:,:,i-2)
2092 ! if (i .gt. iatel_s+2) then
2093 if (i .gt. nnt+2) then
2094 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2095 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2096 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2098 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2099 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2100 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2101 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2102 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2113 DtUg2(l,k,i-2)=0.0d0
2117 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2118 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2120 muder(k,i-2)=Ub2der(k,i-2)
2122 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2123 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2124 if (itype(i-1).le.ntyp) then
2125 iti1 = itortyp(itype(i-1))
2133 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2135 !d write (iout,*) 'mu ',mu(:,i-2)
2136 !d write (iout,*) 'mu1',mu1(:,i-2)
2137 !d write (iout,*) 'mu2',mu2(:,i-2)
2138 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2140 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2141 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2142 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2143 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2144 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2145 ! Vectors and matrices dependent on a single virtual-bond dihedral.
2146 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2147 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2148 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2149 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2150 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2151 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2152 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2153 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2154 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2157 ! Matrices dependent on two consecutive virtual-bond dihedrals.
2158 ! The order of matrices is from left to right.
2159 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2161 ! do i=max0(ivec_start,2),ivec_end
2163 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2164 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2165 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2166 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2167 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2168 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2169 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2170 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2173 #if defined(MPI) && defined(PARMAT)
2176 ! if (fg_rank.eq.0) then
2177 write (iout,*) "Arrays UG and UGDER before GATHER"
2179 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2180 ((ug(l,k,i),l=1,2),k=1,2),&
2181 ((ugder(l,k,i),l=1,2),k=1,2)
2183 write (iout,*) "Arrays UG2 and UG2DER"
2185 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2186 ((ug2(l,k,i),l=1,2),k=1,2),&
2187 ((ug2der(l,k,i),l=1,2),k=1,2)
2189 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2191 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2192 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2193 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2195 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2197 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2198 costab(i),sintab(i),costab2(i),sintab2(i)
2200 write (iout,*) "Array MUDER"
2202 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2206 if (nfgtasks.gt.1) then
2208 ! write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2209 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2210 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2212 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),&
2213 MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2215 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),&
2216 MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2218 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),&
2219 MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2221 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),&
2222 MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2224 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),&
2225 MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2227 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),&
2228 MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2230 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),&
2231 MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),&
2232 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2233 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),&
2234 MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),&
2235 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2236 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),&
2237 MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),&
2238 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2239 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),&
2240 MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),&
2241 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2242 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2244 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),&
2245 MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2247 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),&
2248 MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2250 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),&
2251 MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2253 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),&
2254 MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2256 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),&
2257 MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2259 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),&
2260 ivec_count(fg_rank1),&
2261 MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2263 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),&
2264 MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2266 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),&
2267 MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2269 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),&
2270 MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2272 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),&
2273 MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2275 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),&
2276 MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2278 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),&
2279 MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2281 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),&
2282 MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2284 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),&
2285 ivec_count(fg_rank1),&
2286 MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2288 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),&
2289 MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2291 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),&
2292 MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2294 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),&
2295 MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2297 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),&
2298 MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2300 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),&
2301 ivec_count(fg_rank1),&
2302 MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2304 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),&
2305 ivec_count(fg_rank1),&
2306 MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2308 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),&
2309 ivec_count(fg_rank1),&
2310 MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2311 MPI_MAT2,FG_COMM1,IERR)
2312 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),&
2313 ivec_count(fg_rank1),&
2314 MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2315 MPI_MAT2,FG_COMM1,IERR)
2318 ! Passes matrix info through the ring
2321 if (irecv.lt.0) irecv=nfgtasks1-1
2324 if (inext.ge.nfgtasks1) inext=0
2326 ! write (iout,*) "isend",isend," irecv",irecv
2328 lensend=lentyp(isend)
2329 lenrecv=lentyp(irecv)
2330 ! write (iout,*) "lensend",lensend," lenrecv",lenrecv
2331 ! call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2332 ! & MPI_ROTAT1(lensend),inext,2200+isend,
2333 ! & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2334 ! & iprev,2200+irecv,FG_COMM,status,IERR)
2335 ! write (iout,*) "Gather ROTAT1"
2337 ! call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2338 ! & MPI_ROTAT2(lensend),inext,3300+isend,
2339 ! & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2340 ! & iprev,3300+irecv,FG_COMM,status,IERR)
2341 ! write (iout,*) "Gather ROTAT2"
2343 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,&
2344 MPI_ROTAT_OLD(lensend),inext,4400+isend,&
2345 costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),&
2346 iprev,4400+irecv,FG_COMM,status,IERR)
2347 ! write (iout,*) "Gather ROTAT_OLD"
2349 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,&
2350 MPI_PRECOMP11(lensend),inext,5500+isend,&
2351 mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),&
2352 iprev,5500+irecv,FG_COMM,status,IERR)
2353 ! write (iout,*) "Gather PRECOMP11"
2355 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,&
2356 MPI_PRECOMP12(lensend),inext,6600+isend,&
2357 Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),&
2358 iprev,6600+irecv,FG_COMM,status,IERR)
2359 ! write (iout,*) "Gather PRECOMP12"
2361 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2363 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,&
2364 MPI_ROTAT2(lensend),inext,7700+isend,&
2365 ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),&
2366 iprev,7700+irecv,FG_COMM,status,IERR)
2367 ! write (iout,*) "Gather PRECOMP21"
2369 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,&
2370 MPI_PRECOMP22(lensend),inext,8800+isend,&
2371 EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),&
2372 iprev,8800+irecv,FG_COMM,status,IERR)
2373 ! write (iout,*) "Gather PRECOMP22"
2375 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,&
2376 MPI_PRECOMP23(lensend),inext,9900+isend,&
2377 Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,&
2378 MPI_PRECOMP23(lenrecv),&
2379 iprev,9900+irecv,FG_COMM,status,IERR)
2380 ! write (iout,*) "Gather PRECOMP23"
2385 if (irecv.lt.0) irecv=nfgtasks1-1
2388 time_gather=time_gather+MPI_Wtime()-time00
2391 ! if (fg_rank.eq.0) then
2392 write (iout,*) "Arrays UG and UGDER"
2394 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2395 ((ug(l,k,i),l=1,2),k=1,2),&
2396 ((ugder(l,k,i),l=1,2),k=1,2)
2398 write (iout,*) "Arrays UG2 and UG2DER"
2400 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2401 ((ug2(l,k,i),l=1,2),k=1,2),&
2402 ((ug2der(l,k,i),l=1,2),k=1,2)
2404 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2406 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2407 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2408 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2410 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2412 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2413 costab(i),sintab(i),costab2(i),sintab2(i)
2415 write (iout,*) "Array MUDER"
2417 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2423 !d iti = itortyp(itype(i))
2426 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2427 !d & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2432 end subroutine set_matrices
2433 !-----------------------------------------------------------------------------
2434 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2436 ! This subroutine calculates the average interaction energy and its gradient
2437 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
2438 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2439 ! The potential depends both on the distance of peptide-group centers and on
2440 ! the orientation of the CA-CA virtual bonds.
2443 ! implicit real*8 (a-h,o-z)
2447 ! include 'DIMENSIONS'
2448 ! include 'COMMON.CONTROL'
2449 ! include 'COMMON.SETUP'
2450 ! include 'COMMON.IOUNITS'
2451 ! include 'COMMON.GEO'
2452 ! include 'COMMON.VAR'
2453 ! include 'COMMON.LOCAL'
2454 ! include 'COMMON.CHAIN'
2455 ! include 'COMMON.DERIV'
2456 ! include 'COMMON.INTERACT'
2457 ! include 'COMMON.CONTACTS'
2458 ! include 'COMMON.TORSION'
2459 ! include 'COMMON.VECTORS'
2460 ! include 'COMMON.FFIELD'
2461 ! include 'COMMON.TIME1'
2462 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
2463 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2464 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2465 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2466 real(kind=8),dimension(4) :: muij
2467 !el integer :: num_conti,j1,j2
2468 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2469 !el dz_normi,xmedi,ymedi,zmedi
2471 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2472 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
2475 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2477 real(kind=8) :: scal_el=1.0d0
2479 real(kind=8) :: scal_el=0.5d0
2482 ! 13-go grudnia roku pamietnego...
2483 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
2485 0.0d0,0.0d0,1.0d0/),shape(unmat))
2488 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2489 real(kind=8) :: fac,t_eelecij
2492 !d write(iout,*) 'In EELEC'
2494 !d write(iout,*) 'Type',i
2495 !d write(iout,*) 'B1',B1(:,i)
2496 !d write(iout,*) 'B2',B2(:,i)
2497 !d write(iout,*) 'CC',CC(:,:,i)
2498 !d write(iout,*) 'DD',DD(:,:,i)
2499 !d write(iout,*) 'EE',EE(:,:,i)
2501 !d call check_vecgrad
2503 if (icheckgrad.eq.1) then
2505 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2507 dc_norm(k,i)=dc(k,i)*fac
2509 ! write (iout,*) 'i',i,' fac',fac
2512 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
2513 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
2514 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2515 ! call vec_and_deriv
2521 time_mat=time_mat+MPI_Wtime()-time01
2525 !d write (iout,*) 'i=',i
2527 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2530 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2531 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2544 !d print '(a)','Enter EELEC'
2545 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2546 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
2547 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
2549 gel_loc_loc(i)=0.0d0
2554 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2556 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
2561 do i=iturn3_start,iturn3_end
2562 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
2563 .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2567 dx_normi=dc_norm(1,i)
2568 dy_normi=dc_norm(2,i)
2569 dz_normi=dc_norm(3,i)
2570 xmedi=c(1,i)+0.5d0*dxi
2571 ymedi=c(2,i)+0.5d0*dyi
2572 zmedi=c(3,i)+0.5d0*dzi
2574 call eelecij(i,i+2,ees,evdw1,eel_loc)
2575 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2576 num_cont_hb(i)=num_conti
2578 do i=iturn4_start,iturn4_end
2579 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
2580 .or. itype(i+3).eq.ntyp1 &
2581 .or. itype(i+4).eq.ntyp1) cycle
2585 dx_normi=dc_norm(1,i)
2586 dy_normi=dc_norm(2,i)
2587 dz_normi=dc_norm(3,i)
2588 xmedi=c(1,i)+0.5d0*dxi
2589 ymedi=c(2,i)+0.5d0*dyi
2590 zmedi=c(3,i)+0.5d0*dzi
2591 num_conti=num_cont_hb(i)
2592 call eelecij(i,i+3,ees,evdw1,eel_loc)
2593 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
2594 call eturn4(i,eello_turn4)
2595 num_cont_hb(i)=num_conti
2598 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2600 do i=iatel_s,iatel_e
2601 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2605 dx_normi=dc_norm(1,i)
2606 dy_normi=dc_norm(2,i)
2607 dz_normi=dc_norm(3,i)
2608 xmedi=c(1,i)+0.5d0*dxi
2609 ymedi=c(2,i)+0.5d0*dyi
2610 zmedi=c(3,i)+0.5d0*dzi
2611 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2612 num_conti=num_cont_hb(i)
2613 do j=ielstart(i),ielend(i)
2614 ! write (iout,*) i,j,itype(i),itype(j)
2615 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2616 call eelecij(i,j,ees,evdw1,eel_loc)
2618 num_cont_hb(i)=num_conti
2620 ! write (iout,*) "Number of loop steps in EELEC:",ind
2622 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
2623 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2625 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2626 !cc eel_loc=eel_loc+eello_turn3
2627 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
2629 end subroutine eelec
2630 !-----------------------------------------------------------------------------
2631 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2634 ! implicit real*8 (a-h,o-z)
2635 ! include 'DIMENSIONS'
2639 ! include 'COMMON.CONTROL'
2640 ! include 'COMMON.IOUNITS'
2641 ! include 'COMMON.GEO'
2642 ! include 'COMMON.VAR'
2643 ! include 'COMMON.LOCAL'
2644 ! include 'COMMON.CHAIN'
2645 ! include 'COMMON.DERIV'
2646 ! include 'COMMON.INTERACT'
2647 ! include 'COMMON.CONTACTS'
2648 ! include 'COMMON.TORSION'
2649 ! include 'COMMON.VECTORS'
2650 ! include 'COMMON.FFIELD'
2651 ! include 'COMMON.TIME1'
2652 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
2653 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2654 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2655 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2656 real(kind=8),dimension(4) :: muij
2657 !el integer :: num_conti,j1,j2
2658 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2659 !el dz_normi,xmedi,ymedi,zmedi
2661 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2662 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
2665 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2667 real(kind=8) :: scal_el=1.0d0
2669 real(kind=8) :: scal_el=0.5d0
2672 ! 13-go grudnia roku pamietnego...
2673 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
2675 0.0d0,0.0d0,1.0d0/),shape(unmat))
2676 ! integer :: maxconts=nres/4
2678 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m
2679 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
2680 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
2681 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
2682 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
2683 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
2684 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
2685 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
2686 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
2687 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
2688 ecosgp,ecosam,ecosbm,ecosgm,ghalf
2690 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
2691 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
2693 ! time00=MPI_Wtime()
2694 !d write (iout,*) "eelecij",i,j
2698 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2699 aaa=app(iteli,itelj)
2700 bbb=bpp(iteli,itelj)
2701 ael6i=ael6(iteli,itelj)
2702 ael3i=ael3(iteli,itelj)
2706 dx_normj=dc_norm(1,j)
2707 dy_normj=dc_norm(2,j)
2708 dz_normj=dc_norm(3,j)
2709 xj=c(1,j)+0.5D0*dxj-xmedi
2710 yj=c(2,j)+0.5D0*dyj-ymedi
2711 zj=c(3,j)+0.5D0*dzj-zmedi
2712 rij=xj*xj+yj*yj+zj*zj
2718 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2719 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2720 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2721 fac=cosa-3.0D0*cosb*cosg
2723 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2724 if (j.eq.i+2) ev1=scal_el*ev1
2729 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2732 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
2733 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2736 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2737 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2738 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2739 !d & xmedi,ymedi,zmedi,xj,yj,zj
2741 if (energy_dec) then
2742 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
2743 'evdw1',i,j,evdwij,&
2744 iteli,itelj,aaa,evdw1
2745 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2748 ! Calculate contributions to the Cartesian gradient.
2751 facvdw=-6*rrmij*(ev1+evdwij)
2752 facel=-3*rrmij*(el1+eesij)
2758 ! Radial derivatives. First process both termini of the fragment (i,j)
2764 ! ghalf=0.5D0*ggg(k)
2765 ! gelc(k,i)=gelc(k,i)+ghalf
2766 ! gelc(k,j)=gelc(k,j)+ghalf
2768 ! 9/28/08 AL Gradient compotents will be summed only at the end
2770 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2771 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2774 ! Loop over residues i+1 thru j-1.
2778 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2785 ! ghalf=0.5D0*ggg(k)
2786 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2787 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2789 ! 9/28/08 AL Gradient compotents will be summed only at the end
2791 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2792 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2795 ! Loop over residues i+1 thru j-1.
2799 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2806 fac=-3*rrmij*(facvdw+facvdw+facel)
2811 ! Radial derivatives. First process both termini of the fragment (i,j)
2817 ! ghalf=0.5D0*ggg(k)
2818 ! gelc(k,i)=gelc(k,i)+ghalf
2819 ! gelc(k,j)=gelc(k,j)+ghalf
2821 ! 9/28/08 AL Gradient compotents will be summed only at the end
2823 gelc_long(k,j)=gelc(k,j)+ggg(k)
2824 gelc_long(k,i)=gelc(k,i)-ggg(k)
2827 ! Loop over residues i+1 thru j-1.
2831 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2834 ! 9/28/08 AL Gradient compotents will be summed only at the end
2839 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2840 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2846 ecosa=2.0D0*fac3*fac1+fac4
2849 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2850 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2852 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2853 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2855 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2856 !d & (dcosg(k),k=1,3)
2858 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2861 ! ghalf=0.5D0*ggg(k)
2862 ! gelc(k,i)=gelc(k,i)+ghalf
2863 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2864 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2865 ! gelc(k,j)=gelc(k,j)+ghalf
2866 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2867 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2871 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2875 gelc(k,i)=gelc(k,i) &
2876 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
2877 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2878 gelc(k,j)=gelc(k,j) &
2879 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
2880 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2881 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2882 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2884 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
2885 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
2886 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2888 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2889 ! energy of a peptide unit is assumed in the form of a second-order
2890 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2891 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2892 ! are computed for EVERY pair of non-contiguous peptide groups.
2894 if (j.lt.nres-1) then
2905 muij(kkk)=mu(k,i)*mu(l,j)
2908 !d write (iout,*) 'EELEC: i',i,' j',j
2909 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
2910 !d write(iout,*) 'muij',muij
2911 ury=scalar(uy(1,i),erij)
2912 urz=scalar(uz(1,i),erij)
2913 vry=scalar(uy(1,j),erij)
2914 vrz=scalar(uz(1,j),erij)
2915 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2916 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2917 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2918 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2919 fac=dsqrt(-ael6i)*r3ij
2924 !d write (iout,'(4i5,4f10.5)')
2925 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2926 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2927 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2928 !d & uy(:,j),uz(:,j)
2929 !d write (iout,'(4f10.5)')
2930 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2931 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2932 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
2933 !d write (iout,'(9f10.5/)')
2934 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2935 ! Derivatives of the elements of A in virtual-bond vectors
2936 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2938 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2939 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2940 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2941 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2942 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2943 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2944 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2945 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2946 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2947 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2948 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2949 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2951 ! Compute radial contributions to the gradient
2969 ! Add the contributions coming from er
2972 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2973 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2974 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2975 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2978 ! Derivatives in DC(i)
2979 !grad ghalf1=0.5d0*agg(k,1)
2980 !grad ghalf2=0.5d0*agg(k,2)
2981 !grad ghalf3=0.5d0*agg(k,3)
2982 !grad ghalf4=0.5d0*agg(k,4)
2983 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
2984 -3.0d0*uryg(k,2)*vry)!+ghalf1
2985 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
2986 -3.0d0*uryg(k,2)*vrz)!+ghalf2
2987 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
2988 -3.0d0*urzg(k,2)*vry)!+ghalf3
2989 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
2990 -3.0d0*urzg(k,2)*vrz)!+ghalf4
2991 ! Derivatives in DC(i+1)
2992 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
2993 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
2994 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
2995 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
2996 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
2997 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
2998 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
2999 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3000 ! Derivatives in DC(j)
3001 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
3002 -3.0d0*vryg(k,2)*ury)!+ghalf1
3003 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
3004 -3.0d0*vrzg(k,2)*ury)!+ghalf2
3005 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
3006 -3.0d0*vryg(k,2)*urz)!+ghalf3
3007 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
3008 -3.0d0*vrzg(k,2)*urz)!+ghalf4
3009 ! Derivatives in DC(j+1) or DC(nres-1)
3010 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
3011 -3.0d0*vryg(k,3)*ury)
3012 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
3013 -3.0d0*vrzg(k,3)*ury)
3014 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
3015 -3.0d0*vryg(k,3)*urz)
3016 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
3017 -3.0d0*vrzg(k,3)*urz)
3018 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
3020 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3033 aggi(k,l)=-aggi(k,l)
3034 aggi1(k,l)=-aggi1(k,l)
3035 aggj(k,l)=-aggj(k,l)
3036 aggj1(k,l)=-aggj1(k,l)
3039 if (j.lt.nres-1) then
3045 aggi(k,l)=-aggi(k,l)
3046 aggi1(k,l)=-aggi1(k,l)
3047 aggj(k,l)=-aggj(k,l)
3048 aggj1(k,l)=-aggj1(k,l)
3059 aggi(k,l)=-aggi(k,l)
3060 aggi1(k,l)=-aggi1(k,l)
3061 aggj(k,l)=-aggj(k,l)
3062 aggj1(k,l)=-aggj1(k,l)
3067 IF (wel_loc.gt.0.0d0) THEN
3068 ! Contribution to the local-electrostatic energy coming from the i-j pair
3069 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
3071 !d write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3073 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3074 'eelloc',i,j,eel_loc_ij
3075 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3077 eel_loc=eel_loc+eel_loc_ij
3078 ! Partial derivatives in virtual-bond dihedral angles gamma
3080 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
3081 a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
3082 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3083 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
3084 a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
3085 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3086 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3088 ggg(l)=agg(l,1)*muij(1)+ &
3089 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3090 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3091 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3092 !grad ghalf=0.5d0*ggg(l)
3093 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
3094 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
3098 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3101 ! Remaining derivatives of eello
3103 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ &
3104 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3105 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ &
3106 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3107 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ &
3108 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3109 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ &
3110 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3113 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
3114 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
3115 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
3116 .and. num_conti.le.maxconts) then
3117 ! write (iout,*) i,j," entered corr"
3119 ! Calculate the contact function. The ith column of the array JCONT will
3120 ! contain the numbers of atoms that make contacts with the atom I (of numbers
3121 ! greater than I). The arrays FACONT and GACONT will contain the values of
3122 ! the contact function and its derivative.
3123 ! r0ij=1.02D0*rpp(iteli,itelj)
3124 ! r0ij=1.11D0*rpp(iteli,itelj)
3125 r0ij=2.20D0*rpp(iteli,itelj)
3126 ! r0ij=1.55D0*rpp(iteli,itelj)
3127 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3128 if (fcont.gt.0.0D0) then
3129 num_conti=num_conti+1
3130 if (num_conti.gt.maxconts) then
3131 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
3132 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
3133 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
3134 ' will skip next contacts for this conf.', num_conti
3136 jcont_hb(num_conti,i)=j
3137 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
3138 !d & " jcont_hb",jcont_hb(num_conti,i)
3139 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
3140 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3141 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3143 d_cont(num_conti,i)=rij
3144 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3145 ! --- Electrostatic-interaction matrix ---
3146 a_chuj(1,1,num_conti,i)=a22
3147 a_chuj(1,2,num_conti,i)=a23
3148 a_chuj(2,1,num_conti,i)=a32
3149 a_chuj(2,2,num_conti,i)=a33
3150 ! --- Gradient of rij
3152 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3159 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3160 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3161 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3162 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3163 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3168 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3169 ! Calculate contact energies
3171 wij=cosa-3.0D0*cosb*cosg
3174 ! fac3=dsqrt(-ael6i)/r0ij**3
3175 fac3=dsqrt(-ael6i)*r3ij
3176 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3177 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3178 if (ees0tmp.gt.0) then
3179 ees0pij=dsqrt(ees0tmp)
3183 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3184 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3185 if (ees0tmp.gt.0) then
3186 ees0mij=dsqrt(ees0tmp)
3191 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3192 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3193 ! Diagnostics. Comment out or remove after debugging!
3194 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3195 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3196 ! ees0m(num_conti,i)=0.0D0
3198 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3199 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3200 ! Angular derivatives of the contact function
3201 ees0pij1=fac3/ees0pij
3202 ees0mij1=fac3/ees0mij
3203 fac3p=-3.0D0*fac3*rrmij
3204 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3205 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3207 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3208 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3209 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3210 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3211 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3212 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3213 ecosap=ecosa1+ecosa2
3214 ecosbp=ecosb1+ecosb2
3215 ecosgp=ecosg1+ecosg2
3216 ecosam=ecosa1-ecosa2
3217 ecosbm=ecosb1-ecosb2
3218 ecosgm=ecosg1-ecosg2
3227 facont_hb(num_conti,i)=fcont
3228 fprimcont=fprimcont/rij
3229 !d facont_hb(num_conti,i)=1.0D0
3230 ! Following line is for diagnostics.
3233 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3234 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3237 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3238 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3240 gggp(1)=gggp(1)+ees0pijp*xj
3241 gggp(2)=gggp(2)+ees0pijp*yj
3242 gggp(3)=gggp(3)+ees0pijp*zj
3243 gggm(1)=gggm(1)+ees0mijp*xj
3244 gggm(2)=gggm(2)+ees0mijp*yj
3245 gggm(3)=gggm(3)+ees0mijp*zj
3246 ! Derivatives due to the contact function
3247 gacont_hbr(1,num_conti,i)=fprimcont*xj
3248 gacont_hbr(2,num_conti,i)=fprimcont*yj
3249 gacont_hbr(3,num_conti,i)=fprimcont*zj
3252 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
3253 ! following the change of gradient-summation algorithm.
3255 !grad ghalfp=0.5D0*gggp(k)
3256 !grad ghalfm=0.5D0*gggm(k)
3257 gacontp_hb1(k,num_conti,i)= & !ghalfp+
3258 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3259 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3260 gacontp_hb2(k,num_conti,i)= & !ghalfp+
3261 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3262 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3263 gacontp_hb3(k,num_conti,i)=gggp(k)
3264 gacontm_hb1(k,num_conti,i)= & !ghalfm+
3265 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3266 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3267 gacontm_hb2(k,num_conti,i)= & !ghalfm+
3268 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3269 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3270 gacontm_hb3(k,num_conti,i)=gggm(k)
3272 ! Diagnostics. Comment out or remove after debugging!
3274 !diag gacontp_hb1(k,num_conti,i)=0.0D0
3275 !diag gacontp_hb2(k,num_conti,i)=0.0D0
3276 !diag gacontp_hb3(k,num_conti,i)=0.0D0
3277 !diag gacontm_hb1(k,num_conti,i)=0.0D0
3278 !diag gacontm_hb2(k,num_conti,i)=0.0D0
3279 !diag gacontm_hb3(k,num_conti,i)=0.0D0
3282 endif ! num_conti.le.maxconts
3285 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3288 ghalf=0.5d0*agg(l,k)
3289 aggi(l,k)=aggi(l,k)+ghalf
3290 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3291 aggj(l,k)=aggj(l,k)+ghalf
3294 if (j.eq.nres-1 .and. i.lt.j-2) then
3297 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3302 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
3304 end subroutine eelecij
3305 !-----------------------------------------------------------------------------
3306 subroutine eturn3(i,eello_turn3)
3307 ! Third- and fourth-order contributions from turns
3310 ! implicit real*8 (a-h,o-z)
3311 ! include 'DIMENSIONS'
3312 ! include 'COMMON.IOUNITS'
3313 ! include 'COMMON.GEO'
3314 ! include 'COMMON.VAR'
3315 ! include 'COMMON.LOCAL'
3316 ! include 'COMMON.CHAIN'
3317 ! include 'COMMON.DERIV'
3318 ! include 'COMMON.INTERACT'
3319 ! include 'COMMON.CONTACTS'
3320 ! include 'COMMON.TORSION'
3321 ! include 'COMMON.VECTORS'
3322 ! include 'COMMON.FFIELD'
3323 ! include 'COMMON.CONTROL'
3324 real(kind=8),dimension(3) :: ggg
3325 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
3326 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
3327 real(kind=8),dimension(2) :: auxvec,auxvec1
3328 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3329 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
3330 !el integer :: num_conti,j1,j2
3331 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3332 !el dz_normi,xmedi,ymedi,zmedi
3334 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3335 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3339 real(kind=8) :: eello_turn3
3342 ! write (iout,*) "eturn3",i,j,j1,j2
3347 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3349 ! Third-order contributions
3356 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3357 !d call checkint_turn3(i,a_temp,eello_turn3_num)
3358 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3359 call transpose2(auxmat(1,1),auxmat1(1,1))
3360 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3361 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3362 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3363 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3364 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
3365 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
3366 !d & ' eello_turn3_num',4*eello_turn3_num
3367 ! Derivatives in gamma(i)
3368 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3369 call transpose2(auxmat2(1,1),auxmat3(1,1))
3370 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3371 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3372 ! Derivatives in gamma(i+1)
3373 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3374 call transpose2(auxmat2(1,1),auxmat3(1,1))
3375 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3376 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
3377 +0.5d0*(pizda(1,1)+pizda(2,2))
3378 ! Cartesian derivatives
3380 ! ghalf1=0.5d0*agg(l,1)
3381 ! ghalf2=0.5d0*agg(l,2)
3382 ! ghalf3=0.5d0*agg(l,3)
3383 ! ghalf4=0.5d0*agg(l,4)
3384 a_temp(1,1)=aggi(l,1)!+ghalf1
3385 a_temp(1,2)=aggi(l,2)!+ghalf2
3386 a_temp(2,1)=aggi(l,3)!+ghalf3
3387 a_temp(2,2)=aggi(l,4)!+ghalf4
3388 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3389 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
3390 +0.5d0*(pizda(1,1)+pizda(2,2))
3391 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3392 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3393 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3394 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3395 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3396 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
3397 +0.5d0*(pizda(1,1)+pizda(2,2))
3398 a_temp(1,1)=aggj(l,1)!+ghalf1
3399 a_temp(1,2)=aggj(l,2)!+ghalf2
3400 a_temp(2,1)=aggj(l,3)!+ghalf3
3401 a_temp(2,2)=aggj(l,4)!+ghalf4
3402 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3403 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
3404 +0.5d0*(pizda(1,1)+pizda(2,2))
3405 a_temp(1,1)=aggj1(l,1)
3406 a_temp(1,2)=aggj1(l,2)
3407 a_temp(2,1)=aggj1(l,3)
3408 a_temp(2,2)=aggj1(l,4)
3409 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3410 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
3411 +0.5d0*(pizda(1,1)+pizda(2,2))
3414 end subroutine eturn3
3415 !-----------------------------------------------------------------------------
3416 subroutine eturn4(i,eello_turn4)
3417 ! Third- and fourth-order contributions from turns
3420 ! implicit real*8 (a-h,o-z)
3421 ! include 'DIMENSIONS'
3422 ! include 'COMMON.IOUNITS'
3423 ! include 'COMMON.GEO'
3424 ! include 'COMMON.VAR'
3425 ! include 'COMMON.LOCAL'
3426 ! include 'COMMON.CHAIN'
3427 ! include 'COMMON.DERIV'
3428 ! include 'COMMON.INTERACT'
3429 ! include 'COMMON.CONTACTS'
3430 ! include 'COMMON.TORSION'
3431 ! include 'COMMON.VECTORS'
3432 ! include 'COMMON.FFIELD'
3433 ! include 'COMMON.CONTROL'
3434 real(kind=8),dimension(3) :: ggg
3435 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
3436 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
3437 real(kind=8),dimension(2) :: auxvec,auxvec1
3438 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3439 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
3440 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3441 !el dz_normi,xmedi,ymedi,zmedi
3442 !el integer :: num_conti,j1,j2
3443 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3444 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3447 integer :: i,j,iti1,iti2,iti3,l
3448 real(kind=8) :: eello_turn4,s1,s2,s3
3451 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3453 ! Fourth-order contributions
3461 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3462 !d call checkint_turn4(i,a_temp,eello_turn4_num)
3463 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3468 iti1=itortyp(itype(i+1))
3469 iti2=itortyp(itype(i+2))
3470 iti3=itortyp(itype(i+3))
3471 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3472 call transpose2(EUg(1,1,i+1),e1t(1,1))
3473 call transpose2(Eug(1,1,i+2),e2t(1,1))
3474 call transpose2(Eug(1,1,i+3),e3t(1,1))
3475 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3476 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3477 s1=scalar2(b1(1,iti2),auxvec(1))
3478 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3479 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3480 s2=scalar2(b1(1,iti1),auxvec(1))
3481 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3482 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3483 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3484 eello_turn4=eello_turn4-(s1+s2+s3)
3485 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3486 'eturn4',i,j,-(s1+s2+s3)
3487 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3488 !d & ' eello_turn4_num',8*eello_turn4_num
3489 ! Derivatives in gamma(i)
3490 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3491 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3492 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3493 s1=scalar2(b1(1,iti2),auxvec(1))
3494 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3495 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3496 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3497 ! Derivatives in gamma(i+1)
3498 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3499 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3500 s2=scalar2(b1(1,iti1),auxvec(1))
3501 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3502 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3503 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3504 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3505 ! Derivatives in gamma(i+2)
3506 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3507 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3508 s1=scalar2(b1(1,iti2),auxvec(1))
3509 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3510 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3511 s2=scalar2(b1(1,iti1),auxvec(1))
3512 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3513 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3514 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3515 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3516 ! Cartesian derivatives
3517 ! Derivatives of this turn contributions in DC(i+2)
3518 if (j.lt.nres-1) then
3520 a_temp(1,1)=agg(l,1)
3521 a_temp(1,2)=agg(l,2)
3522 a_temp(2,1)=agg(l,3)
3523 a_temp(2,2)=agg(l,4)
3524 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3525 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3526 s1=scalar2(b1(1,iti2),auxvec(1))
3527 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3528 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3529 s2=scalar2(b1(1,iti1),auxvec(1))
3530 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3531 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3532 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3534 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3537 ! Remaining derivatives of this turn contribution
3539 a_temp(1,1)=aggi(l,1)
3540 a_temp(1,2)=aggi(l,2)
3541 a_temp(2,1)=aggi(l,3)
3542 a_temp(2,2)=aggi(l,4)
3543 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3544 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3545 s1=scalar2(b1(1,iti2),auxvec(1))
3546 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3547 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3548 s2=scalar2(b1(1,iti1),auxvec(1))
3549 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3550 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3551 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3552 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3553 a_temp(1,1)=aggi1(l,1)
3554 a_temp(1,2)=aggi1(l,2)
3555 a_temp(2,1)=aggi1(l,3)
3556 a_temp(2,2)=aggi1(l,4)
3557 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3558 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3559 s1=scalar2(b1(1,iti2),auxvec(1))
3560 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3561 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3562 s2=scalar2(b1(1,iti1),auxvec(1))
3563 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3564 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3565 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3566 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3567 a_temp(1,1)=aggj(l,1)
3568 a_temp(1,2)=aggj(l,2)
3569 a_temp(2,1)=aggj(l,3)
3570 a_temp(2,2)=aggj(l,4)
3571 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3572 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3573 s1=scalar2(b1(1,iti2),auxvec(1))
3574 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3575 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3576 s2=scalar2(b1(1,iti1),auxvec(1))
3577 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3578 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3579 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3580 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3581 a_temp(1,1)=aggj1(l,1)
3582 a_temp(1,2)=aggj1(l,2)
3583 a_temp(2,1)=aggj1(l,3)
3584 a_temp(2,2)=aggj1(l,4)
3585 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3586 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3587 s1=scalar2(b1(1,iti2),auxvec(1))
3588 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3589 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3590 s2=scalar2(b1(1,iti1),auxvec(1))
3591 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3592 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3593 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3594 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3595 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3598 end subroutine eturn4
3599 !-----------------------------------------------------------------------------
3600 subroutine unormderiv(u,ugrad,unorm,ungrad)
3601 ! This subroutine computes the derivatives of a normalized vector u, given
3602 ! the derivatives computed without normalization conditions, ugrad. Returns
3605 real(kind=8),dimension(3) :: u,vec
3606 real(kind=8),dimension(3,3) ::ugrad,ungrad
3607 real(kind=8) :: unorm !,scalar
3609 ! write (2,*) 'ugrad',ugrad
3612 vec(i)=scalar(ugrad(1,i),u(1))
3614 ! write (2,*) 'vec',vec
3617 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3620 ! write (2,*) 'ungrad',ungrad
3622 end subroutine unormderiv
3623 !-----------------------------------------------------------------------------
3624 subroutine escp_soft_sphere(evdw2,evdw2_14)
3626 ! This subroutine calculates the excluded-volume interaction energy between
3627 ! peptide-group centers and side chains and its gradient in virtual-bond and
3628 ! side-chain vectors.
3630 ! implicit real*8 (a-h,o-z)
3631 ! include 'DIMENSIONS'
3632 ! include 'COMMON.GEO'
3633 ! include 'COMMON.VAR'
3634 ! include 'COMMON.LOCAL'
3635 ! include 'COMMON.CHAIN'
3636 ! include 'COMMON.DERIV'
3637 ! include 'COMMON.INTERACT'
3638 ! include 'COMMON.FFIELD'
3639 ! include 'COMMON.IOUNITS'
3640 ! include 'COMMON.CONTROL'
3641 real(kind=8),dimension(3) :: ggg
3643 integer :: i,iint,j,k,iteli,itypj
3644 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
3645 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
3650 !d print '(a)','Enter ESCP'
3651 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3652 do i=iatscp_s,iatscp_e
3653 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3655 xi=0.5D0*(c(1,i)+c(1,i+1))
3656 yi=0.5D0*(c(2,i)+c(2,i+1))
3657 zi=0.5D0*(c(3,i)+c(3,i+1))
3659 do iint=1,nscp_gr(i)
3661 do j=iscpstart(i,iint),iscpend(i,iint)
3662 if (itype(j).eq.ntyp1) cycle
3663 itypj=iabs(itype(j))
3664 ! Uncomment following three lines for SC-p interactions
3668 ! Uncomment following three lines for Ca-p interactions
3672 rij=xj*xj+yj*yj+zj*zj
3675 if (rij.lt.r0ijsq) then
3676 evdwij=0.25d0*(rij-r0ijsq)**2
3684 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
3689 !grad if (j.lt.i) then
3690 !d write (iout,*) 'j<i'
3691 ! Uncomment following three lines for SC-p interactions
3693 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3696 !d write (iout,*) 'j>i'
3698 !grad ggg(k)=-ggg(k)
3699 ! Uncomment following line for SC-p interactions
3700 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3704 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3706 !grad kstart=min0(i+1,j)
3707 !grad kend=max0(i-1,j-1)
3708 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3709 !d write (iout,*) ggg(1),ggg(2),ggg(3)
3710 !grad do k=kstart,kend
3712 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3716 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3717 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3724 end subroutine escp_soft_sphere
3725 !-----------------------------------------------------------------------------
3726 subroutine escp(evdw2,evdw2_14)
3728 ! This subroutine calculates the excluded-volume interaction energy between
3729 ! peptide-group centers and side chains and its gradient in virtual-bond and
3730 ! side-chain vectors.
3732 ! implicit real*8 (a-h,o-z)
3733 ! include 'DIMENSIONS'
3734 ! include 'COMMON.GEO'
3735 ! include 'COMMON.VAR'
3736 ! include 'COMMON.LOCAL'
3737 ! include 'COMMON.CHAIN'
3738 ! include 'COMMON.DERIV'
3739 ! include 'COMMON.INTERACT'
3740 ! include 'COMMON.FFIELD'
3741 ! include 'COMMON.IOUNITS'
3742 ! include 'COMMON.CONTROL'
3743 real(kind=8),dimension(3) :: ggg
3745 integer :: i,iint,j,k,iteli,itypj
3746 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
3751 !d print '(a)','Enter ESCP'
3752 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3753 do i=iatscp_s,iatscp_e
3754 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3756 xi=0.5D0*(c(1,i)+c(1,i+1))
3757 yi=0.5D0*(c(2,i)+c(2,i+1))
3758 zi=0.5D0*(c(3,i)+c(3,i+1))
3760 do iint=1,nscp_gr(i)
3762 do j=iscpstart(i,iint),iscpend(i,iint)
3763 itypj=iabs(itype(j))
3764 if (itypj.eq.ntyp1) cycle
3765 ! Uncomment following three lines for SC-p interactions
3769 ! Uncomment following three lines for Ca-p interactions
3773 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3775 e1=fac*fac*aad(itypj,iteli)
3776 e2=fac*bad(itypj,iteli)
3777 if (iabs(j-i) .le. 2) then
3780 evdw2_14=evdw2_14+e1+e2
3784 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
3785 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
3788 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
3790 fac=-(evdwij+e1)*rrij
3794 !grad if (j.lt.i) then
3795 !d write (iout,*) 'j<i'
3796 ! Uncomment following three lines for SC-p interactions
3798 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3801 !d write (iout,*) 'j>i'
3803 !grad ggg(k)=-ggg(k)
3804 ! Uncomment following line for SC-p interactions
3805 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3806 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3810 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3812 !grad kstart=min0(i+1,j)
3813 !grad kend=max0(i-1,j-1)
3814 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3815 !d write (iout,*) ggg(1),ggg(2),ggg(3)
3816 !grad do k=kstart,kend
3818 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3822 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3823 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3831 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3832 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
3833 gradx_scp(j,i)=expon*gradx_scp(j,i)
3836 !******************************************************************************
3840 ! To save time the factor EXPON has been extracted from ALL components
3841 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
3844 !******************************************************************************
3847 !-----------------------------------------------------------------------------
3848 subroutine edis(ehpb)
3850 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3852 ! implicit real*8 (a-h,o-z)
3853 ! include 'DIMENSIONS'
3854 ! include 'COMMON.SBRIDGE'
3855 ! include 'COMMON.CHAIN'
3856 ! include 'COMMON.DERIV'
3857 ! include 'COMMON.VAR'
3858 ! include 'COMMON.INTERACT'
3859 ! include 'COMMON.IOUNITS'
3860 real(kind=8),dimension(3) :: ggg
3862 integer :: i,j,ii,jj,iii,jjj,k
3863 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
3866 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
3867 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
3868 if (link_end.eq.0) return
3869 do i=link_start,link_end
3870 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3871 ! CA-CA distance used in regularization of structure.
3874 ! iii and jjj point to the residues for which the distance is assigned.
3875 if (ii.gt.nres) then
3882 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
3883 ! & dhpb(i),dhpb1(i),forcon(i)
3884 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
3885 ! distance and angle dependent SS bond potential.
3886 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
3887 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
3888 if (.not.dyn_ss .and. i.le.nss) then
3889 ! 15/02/13 CC dynamic SSbond - additional check
3890 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. &
3891 iabs(itype(jjj)).eq.1) then
3892 call ssbond_ene(iii,jjj,eij)
3894 !d write (iout,*) "eij",eij
3897 ! Calculate the distance between the two points and its difference from the
3901 ! Get the force constant corresponding to this distance.
3903 ! Calculate the contribution to energy.
3904 ehpb=ehpb+waga*rdis*rdis
3906 ! Evaluate gradient.
3909 !d print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3910 !d & ' waga=',waga,' fac=',fac
3912 ggg(j)=fac*(c(j,jj)-c(j,ii))
3914 !d print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3915 ! If this is a SC-SC distance, we need to calculate the contributions to the
3916 ! Cartesian gradient in the SC vectors (ghpbx).
3919 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3920 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3923 !grad do j=iii,jjj-1
3925 !grad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3929 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3930 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3937 !-----------------------------------------------------------------------------
3938 subroutine ssbond_ene(i,j,eij)
3940 ! Calculate the distance and angle dependent SS-bond potential energy
3941 ! using a free-energy function derived based on RHF/6-31G** ab initio
3942 ! calculations of diethyl disulfide.
3944 ! A. Liwo and U. Kozlowska, 11/24/03
3946 ! implicit real*8 (a-h,o-z)
3947 ! include 'DIMENSIONS'
3948 ! include 'COMMON.SBRIDGE'
3949 ! include 'COMMON.CHAIN'
3950 ! include 'COMMON.DERIV'
3951 ! include 'COMMON.LOCAL'
3952 ! include 'COMMON.INTERACT'
3953 ! include 'COMMON.VAR'
3954 ! include 'COMMON.IOUNITS'
3955 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
3957 integer :: i,j,itypi,itypj,k
3958 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
3959 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
3960 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
3963 itypi=iabs(itype(i))
3967 dxi=dc_norm(1,nres+i)
3968 dyi=dc_norm(2,nres+i)
3969 dzi=dc_norm(3,nres+i)
3970 ! dsci_inv=dsc_inv(itypi)
3971 dsci_inv=vbld_inv(nres+i)
3972 itypj=iabs(itype(j))
3973 ! dscj_inv=dsc_inv(itypj)
3974 dscj_inv=vbld_inv(nres+j)
3978 dxj=dc_norm(1,nres+j)
3979 dyj=dc_norm(2,nres+j)
3980 dzj=dc_norm(3,nres+j)
3981 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3986 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3987 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3988 om12=dxi*dxj+dyi*dyj+dzi*dzj
3990 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3991 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3997 deltat12=om2-om1+2.0d0
3999 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
4000 +akct*deltad*deltat12 &
4001 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4002 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4003 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4004 ! & " deltat12",deltat12," eij",eij
4005 ed=2*akcm*deltad+akct*deltat12
4007 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4008 eom1=-2*akth*deltat1-pom1-om2*pom2
4009 eom2= 2*akth*deltat2+pom1-om1*pom2
4012 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4013 ghpbx(k,i)=ghpbx(k,i)-ggk &
4014 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
4015 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4016 ghpbx(k,j)=ghpbx(k,j)+ggk &
4017 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
4018 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4019 ghpbc(k,i)=ghpbc(k,i)-ggk
4020 ghpbc(k,j)=ghpbc(k,j)+ggk
4023 ! Calculate the components of the gradient in DC and X
4027 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4031 end subroutine ssbond_ene
4032 !-----------------------------------------------------------------------------
4033 subroutine ebond(estr)
4035 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4037 ! implicit real*8 (a-h,o-z)
4038 ! include 'DIMENSIONS'
4039 ! include 'COMMON.LOCAL'
4040 ! include 'COMMON.GEO'
4041 ! include 'COMMON.INTERACT'
4042 ! include 'COMMON.DERIV'
4043 ! include 'COMMON.VAR'
4044 ! include 'COMMON.CHAIN'
4045 ! include 'COMMON.IOUNITS'
4046 ! include 'COMMON.NAMES'
4047 ! include 'COMMON.FFIELD'
4048 ! include 'COMMON.CONTROL'
4049 ! include 'COMMON.SETUP'
4050 real(kind=8),dimension(3) :: u,ud
4052 integer :: i,j,iti,nbi,k
4053 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
4058 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
4059 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
4061 do i=ibondp_start,ibondp_end
4062 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4063 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4065 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
4068 if (energy_dec) write(iout,*) &
4069 "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4071 diff = vbld(i)-vbldp0
4072 if (energy_dec) write (iout,*) &
4073 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4076 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4078 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4081 estr=0.5d0*AKP*estr+estr1
4083 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4085 do i=ibond_start,ibond_end
4087 if (iti.ne.10 .and. iti.ne.ntyp1) then
4090 diff=vbld(i+nres)-vbldsc0(1,iti)
4091 if (energy_dec) write (iout,*) &
4092 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
4093 AKSC(1,iti),AKSC(1,iti)*diff*diff
4094 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4096 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4100 diff=vbld(i+nres)-vbldsc0(j,iti)
4101 ud(j)=aksc(j,iti)*diff
4102 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4116 uprod2=uprod2*u(k)*u(k)
4120 usumsqder=usumsqder+ud(j)*uprod2
4122 estr=estr+uprod/usum
4124 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4130 end subroutine ebond
4132 !-----------------------------------------------------------------------------
4133 subroutine ebend(etheta)
4135 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4136 ! angles gamma and its derivatives in consecutive thetas and gammas.
4139 ! implicit real*8 (a-h,o-z)
4140 ! include 'DIMENSIONS'
4141 ! include 'COMMON.LOCAL'
4142 ! include 'COMMON.GEO'
4143 ! include 'COMMON.INTERACT'
4144 ! include 'COMMON.DERIV'
4145 ! include 'COMMON.VAR'
4146 ! include 'COMMON.CHAIN'
4147 ! include 'COMMON.IOUNITS'
4148 ! include 'COMMON.NAMES'
4149 ! include 'COMMON.FFIELD'
4150 ! include 'COMMON.CONTROL'
4151 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
4152 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4153 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
4155 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
4156 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4157 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4159 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
4161 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
4162 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
4163 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
4164 real(kind=8),dimension(2) :: y,z
4167 ! time11=dexp(-2*time)
4170 ! write (*,'(a,i2)') 'EBEND ICG=',icg
4171 do i=ithet_start,ithet_end
4172 if (itype(i-1).eq.ntyp1) cycle
4173 ! Zero the energy function and its derivative at 0 or pi.
4174 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4176 ichir1=isign(1,itype(i-2))
4177 ichir2=isign(1,itype(i))
4178 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4179 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4180 if (itype(i-1).eq.10) then
4181 itype1=isign(10,itype(i-2))
4182 ichir11=isign(1,itype(i-2))
4183 ichir12=isign(1,itype(i-2))
4184 itype2=isign(10,itype(i))
4185 ichir21=isign(1,itype(i))
4186 ichir22=isign(1,itype(i))
4189 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4192 if (phii.ne.phii) phii=150.0
4202 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4205 if (phii1.ne.phii1) phii1=150.0
4217 ! Calculate the "mean" value of theta from the part of the distribution
4218 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4219 ! In following comments this theta will be referred to as t_c.
4220 thet_pred_mean=0.0d0
4222 athetk=athet(k,it,ichir1,ichir2)
4223 bthetk=bthet(k,it,ichir1,ichir2)
4225 athetk=athet(k,itype1,ichir11,ichir12)
4226 bthetk=bthet(k,itype2,ichir21,ichir22)
4228 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4230 dthett=thet_pred_mean*ssd
4231 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4232 ! Derivatives of the "mean" values in gamma1 and gamma2.
4233 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
4234 +athet(2,it,ichir1,ichir2)*y(1))*ss
4235 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
4236 +bthet(2,it,ichir1,ichir2)*z(1))*ss
4238 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
4239 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
4240 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
4241 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4243 if (theta(i).gt.pi-delta) then
4244 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
4246 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4247 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4248 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
4250 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
4252 else if (theta(i).lt.delta) then
4253 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4254 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4255 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
4257 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4258 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
4261 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
4264 etheta=etheta+ethetai
4265 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
4267 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4268 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4269 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4271 ! Ufff.... We've done all this!!!
4273 end subroutine ebend
4274 !-----------------------------------------------------------------------------
4275 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
4278 ! implicit real*8 (a-h,o-z)
4279 ! include 'DIMENSIONS'
4280 ! include 'COMMON.LOCAL'
4281 ! include 'COMMON.IOUNITS'
4282 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
4283 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4284 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
4286 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
4288 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
4289 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4290 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4292 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
4293 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
4295 ! Calculate the contributions to both Gaussian lobes.
4296 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4297 ! The "polynomial part" of the "standard deviation" of this part of
4301 sig=sig*thet_pred_mean+polthet(j,it)
4303 ! Derivative of the "interior part" of the "standard deviation of the"
4304 ! gamma-dependent Gaussian lobe in t_c.
4305 sigtc=3*polthet(3,it)
4307 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4310 ! Set the parameters of both Gaussian lobes of the distribution.
4311 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4312 fac=sig*sig+sigc0(it)
4315 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4316 sigsqtc=-4.0D0*sigcsq*sigtc
4317 ! print *,i,sig,sigtc,sigsqtc
4318 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
4319 sigtc=-sigtc/(fac*fac)
4320 ! Following variable is sigma(t_c)**(-2)
4321 sigcsq=sigcsq*sigcsq
4323 sig0inv=1.0D0/sig0i**2
4324 delthec=thetai-thet_pred_mean
4325 delthe0=thetai-theta0i
4326 term1=-0.5D0*sigcsq*delthec*delthec
4327 term2=-0.5D0*sig0inv*delthe0*delthe0
4328 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4329 ! NaNs in taking the logarithm. We extract the largest exponent which is added
4330 ! to the energy (this being the log of the distribution) at the end of energy
4331 ! term evaluation for this virtual-bond angle.
4332 if (term1.gt.term2) then
4334 term2=dexp(term2-termm)
4338 term1=dexp(term1-termm)
4341 ! The ratio between the gamma-independent and gamma-dependent lobes of
4342 ! the distribution is a Gaussian function of thet_pred_mean too.
4343 diffak=gthet(2,it)-thet_pred_mean
4344 ratak=diffak/gthet(3,it)**2
4345 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4346 ! Let's differentiate it in thet_pred_mean NOW.
4348 ! Now put together the distribution terms to make complete distribution.
4349 termexp=term1+ak*term2
4350 termpre=sigc+ak*sig0i
4351 ! Contribution of the bending energy from this theta is just the -log of
4352 ! the sum of the contributions from the two lobes and the pre-exponential
4353 ! factor. Simple enough, isn't it?
4354 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4355 ! NOW the derivatives!!!
4356 ! 6/6/97 Take into account the deformation.
4357 E_theta=(delthec*sigcsq*term1 &
4358 +ak*delthe0*sig0inv*term2)/termexp
4359 E_tc=((sigtc+aktc*sig0i)/termpre &
4360 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
4361 aktc*term2)/termexp)
4363 end subroutine theteng
4365 !-----------------------------------------------------------------------------
4366 subroutine ebend(etheta)
4368 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4369 ! angles gamma and its derivatives in consecutive thetas and gammas.
4370 ! ab initio-derived potentials from
4371 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4373 ! implicit real*8 (a-h,o-z)
4374 ! include 'DIMENSIONS'
4375 ! include 'COMMON.LOCAL'
4376 ! include 'COMMON.GEO'
4377 ! include 'COMMON.INTERACT'
4378 ! include 'COMMON.DERIV'
4379 ! include 'COMMON.VAR'
4380 ! include 'COMMON.CHAIN'
4381 ! include 'COMMON.IOUNITS'
4382 ! include 'COMMON.NAMES'
4383 ! include 'COMMON.FFIELD'
4384 ! include 'COMMON.CONTROL'
4385 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
4386 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
4387 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
4388 logical :: lprn=.false., lprn1=.false.
4390 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
4391 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
4392 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl
4395 do i=ithet_start,ithet_end
4396 if (itype(i-1).eq.ntyp1) cycle
4397 if (iabs(itype(i+1)).eq.20) iblock=2
4398 if (iabs(itype(i+1)).ne.20) iblock=1
4402 theti2=0.5d0*theta(i)
4403 ityp2=ithetyp((itype(i-1)))
4405 coskt(k)=dcos(k*theti2)
4406 sinkt(k)=dsin(k*theti2)
4408 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4411 if (phii.ne.phii) phii=150.0
4415 ityp1=ithetyp((itype(i-2)))
4416 ! propagation of chirality for glycine type
4418 cosph1(k)=dcos(k*phii)
4419 sinph1(k)=dsin(k*phii)
4429 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4432 if (phii1.ne.phii1) phii1=150.0
4437 ityp3=ithetyp((itype(i)))
4439 cosph2(k)=dcos(k*phii1)
4440 sinph2(k)=dsin(k*phii1)
4450 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4453 ccl=cosph1(l)*cosph2(k-l)
4454 ssl=sinph1(l)*sinph2(k-l)
4455 scl=sinph1(l)*cosph2(k-l)
4456 csl=cosph1(l)*sinph2(k-l)
4457 cosph1ph2(l,k)=ccl-ssl
4458 cosph1ph2(k,l)=ccl+ssl
4459 sinph1ph2(l,k)=scl+csl
4460 sinph1ph2(k,l)=scl-csl
4464 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
4465 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4466 write (iout,*) "coskt and sinkt"
4468 write (iout,*) k,coskt(k),sinkt(k)
4472 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4473 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
4476 write (iout,*) "k",k,&
4477 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
4481 write (iout,*) "cosph and sinph"
4483 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4485 write (iout,*) "cosph1ph2 and sinph2ph2"
4488 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
4489 sinph1ph2(l,k),sinph1ph2(k,l)
4492 write(iout,*) "ethetai",ethetai
4496 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
4497 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
4498 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
4499 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4500 ethetai=ethetai+sinkt(m)*aux
4501 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4502 dephii=dephii+k*sinkt(m)* &
4503 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
4504 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4505 dephii1=dephii1+k*sinkt(m)* &
4506 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
4507 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4509 write (iout,*) "m",m," k",k," bbthet", &
4510 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
4511 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
4512 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
4513 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4517 write(iout,*) "ethetai",ethetai
4521 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
4522 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
4523 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
4524 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4525 ethetai=ethetai+sinkt(m)*aux
4526 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4527 dephii=dephii+l*sinkt(m)* &
4528 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
4529 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
4530 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
4531 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4532 dephii1=dephii1+(k-l)*sinkt(m)* &
4533 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
4534 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
4535 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
4536 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4538 write (iout,*) "m",m," k",k," l",l," ffthet",&
4539 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
4540 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
4541 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
4542 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
4544 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
4545 cosph1ph2(k,l)*sinkt(m),&
4546 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4554 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
4555 i,theta(i)*rad2deg,phii*rad2deg,&
4556 phii1*rad2deg,ethetai
4558 etheta=etheta+ethetai
4559 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4560 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4561 gloc(nphi+i-2,icg)=wang*dethetai
4564 end subroutine ebend
4567 !-----------------------------------------------------------------------------
4568 subroutine esc(escloc)
4569 ! Calculate the local energy of a side chain and its derivatives in the
4570 ! corresponding virtual-bond valence angles THETA and the spherical angles
4574 ! implicit real*8 (a-h,o-z)
4575 ! include 'DIMENSIONS'
4576 ! include 'COMMON.GEO'
4577 ! include 'COMMON.LOCAL'
4578 ! include 'COMMON.VAR'
4579 ! include 'COMMON.INTERACT'
4580 ! include 'COMMON.DERIV'
4581 ! include 'COMMON.CHAIN'
4582 ! include 'COMMON.IOUNITS'
4583 ! include 'COMMON.NAMES'
4584 ! include 'COMMON.FFIELD'
4585 ! include 'COMMON.CONTROL'
4586 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
4587 ddersc0,ddummy,xtemp,temp
4588 !el real(kind=8) :: time11,time12,time112,theti
4589 real(kind=8) :: escloc,delta
4590 !el integer :: it,nlobit
4591 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4594 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
4595 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
4598 ! write (iout,'(a)') 'ESC'
4599 do i=loc_start,loc_end
4601 if (it.eq.ntyp1) cycle
4602 if (it.eq.10) goto 1
4603 nlobit=nlob(iabs(it))
4604 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
4605 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4606 theti=theta(i+1)-pipol
4611 if (x(2).gt.pi-delta) then
4615 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4617 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4618 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
4620 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
4621 ddersc0(1),dersc(1))
4622 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
4623 ddersc0(3),dersc(3))
4625 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4627 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4628 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
4629 dersc0(2),esclocbi,dersc02)
4630 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
4632 call splinthet(x(2),0.5d0*delta,ss,ssd)
4637 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4639 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4640 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4642 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4644 ! write (iout,*) escloci
4645 else if (x(2).lt.delta) then
4649 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4651 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4652 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
4654 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
4655 ddersc0(1),dersc(1))
4656 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
4657 ddersc0(3),dersc(3))
4659 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4661 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4662 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
4663 dersc0(2),esclocbi,dersc02)
4664 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
4669 call splinthet(x(2),0.5d0*delta,ss,ssd)
4671 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4673 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4674 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4676 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4677 ! write (iout,*) escloci
4679 call enesc(x,escloci,dersc,ddummy,.false.)
4682 escloc=escloc+escloci
4683 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
4685 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4687 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
4689 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4690 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4695 !-----------------------------------------------------------------------------
4696 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4699 ! implicit real*8 (a-h,o-z)
4700 ! include 'DIMENSIONS'
4701 ! include 'COMMON.GEO'
4702 ! include 'COMMON.LOCAL'
4703 ! include 'COMMON.IOUNITS'
4704 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4705 real(kind=8),dimension(3) :: x,z,dersc,ddersc
4706 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
4707 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
4708 real(kind=8) :: escloci
4711 integer :: j,iii,l,k !el,it,nlobit
4712 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
4713 !el time11,time12,time112
4714 ! write (iout,*) 'it=',it,' nlobit=',nlobit
4718 if (mixed) ddersc(j)=0.0d0
4722 ! Because of periodicity of the dependence of the SC energy in omega we have
4723 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4724 ! To avoid underflows, first compute & store the exponents.
4732 z(k)=x(k)-censc(k,j,it)
4737 Axk=Axk+gaussc(l,k,j,it)*z(l)
4743 expfac=expfac+Ax(k,j,iii)*z(k)
4751 ! As in the case of ebend, we want to avoid underflows in exponentiation and
4752 ! subsequent NaNs and INFs in energy calculation.
4753 ! Find the largest exponent
4757 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4761 !d print *,'it=',it,' emin=',emin
4763 ! Compute the contribution to SC energy and derivatives
4768 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
4769 if(adexp.ne.adexp) adexp=1.0
4772 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4774 !d print *,'j=',j,' expfac=',expfac
4775 escloc_i=escloc_i+expfac
4777 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4781 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
4782 +gaussc(k,2,j,it))*expfac
4789 dersc(1)=dersc(1)/cos(theti)**2
4790 ddersc(1)=ddersc(1)/cos(theti)**2
4793 escloci=-(dlog(escloc_i)-emin)
4795 dersc(j)=dersc(j)/escloc_i
4799 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4803 end subroutine enesc
4804 !-----------------------------------------------------------------------------
4805 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4808 ! implicit real*8 (a-h,o-z)
4809 ! include 'DIMENSIONS'
4810 ! include 'COMMON.GEO'
4811 ! include 'COMMON.LOCAL'
4812 ! include 'COMMON.IOUNITS'
4813 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4814 real(kind=8),dimension(3) :: x,z,dersc
4815 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
4816 real(kind=8),dimension(nlobit) :: contr !(maxlob)
4817 real(kind=8) :: escloci,dersc12,emin
4820 integer :: j,k,l !el,it,nlobit
4821 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
4831 z(k)=x(k)-censc(k,j,it)
4837 Axk=Axk+gaussc(l,k,j,it)*z(l)
4843 expfac=expfac+Ax(k,j)*z(k)
4848 ! As in the case of ebend, we want to avoid underflows in exponentiation and
4849 ! subsequent NaNs and INFs in energy calculation.
4850 ! Find the largest exponent
4853 if (emin.gt.contr(j)) emin=contr(j)
4857 ! Compute the contribution to SC energy and derivatives
4861 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4862 escloc_i=escloc_i+expfac
4864 dersc(k)=dersc(k)+Ax(k,j)*expfac
4866 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
4867 +gaussc(1,2,j,it))*expfac
4871 dersc(1)=dersc(1)/cos(theti)**2
4872 dersc12=dersc12/cos(theti)**2
4873 escloci=-(dlog(escloc_i)-emin)
4875 dersc(j)=dersc(j)/escloc_i
4877 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4879 end subroutine enesc_bound
4881 !-----------------------------------------------------------------------------
4882 subroutine esc(escloc)
4883 ! Calculate the local energy of a side chain and its derivatives in the
4884 ! corresponding virtual-bond valence angles THETA and the spherical angles
4885 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
4886 ! added by Urszula Kozlowska. 07/11/2007
4889 ! implicit real*8 (a-h,o-z)
4890 ! include 'DIMENSIONS'
4891 ! include 'COMMON.GEO'
4892 ! include 'COMMON.LOCAL'
4893 ! include 'COMMON.VAR'
4894 ! include 'COMMON.SCROT'
4895 ! include 'COMMON.INTERACT'
4896 ! include 'COMMON.DERIV'
4897 ! include 'COMMON.CHAIN'
4898 ! include 'COMMON.IOUNITS'
4899 ! include 'COMMON.NAMES'
4900 ! include 'COMMON.FFIELD'
4901 ! include 'COMMON.CONTROL'
4902 ! include 'COMMON.VECTORS'
4903 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
4904 real(kind=8),dimension(65) :: x
4905 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
4906 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
4907 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
4908 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
4909 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
4911 integer :: i,j,k !el,it,nlobit
4912 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
4913 !el real(kind=8) :: time11,time12,time112,theti
4914 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4915 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
4916 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
4917 sumene1x,sumene2x,sumene3x,sumene4x,&
4918 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
4922 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
4923 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
4926 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
4930 do i=loc_start,loc_end
4931 if (itype(i).eq.ntyp1) cycle
4932 costtab(i+1) =dcos(theta(i+1))
4933 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4934 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4935 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4936 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4937 cosfac=dsqrt(cosfac2)
4938 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4939 sinfac=dsqrt(sinfac2)
4941 if (it.eq.10) goto 1
4943 ! Compute the axes of tghe local cartesian coordinates system; store in
4944 ! x_prime, y_prime and z_prime
4951 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4952 ! & dc_norm(3,i+nres)
4954 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4955 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4958 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4961 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
4962 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
4963 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
4964 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4965 ! & " xy",scalar(x_prime(1),y_prime(1)),
4966 ! & " xz",scalar(x_prime(1),z_prime(1)),
4967 ! & " yy",scalar(y_prime(1),y_prime(1)),
4968 ! & " yz",scalar(y_prime(1),z_prime(1)),
4969 ! & " zz",scalar(z_prime(1),z_prime(1))
4971 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4972 ! to local coordinate system. Store in xx, yy, zz.
4978 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4979 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4980 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4987 ! Compute the energy of the ith side cbain
4989 ! write (2,*) "xx",xx," yy",yy," zz",zz
4992 x(j) = sc_parmin(j,it)
4995 !c diagnostics - remove later
4997 yy1 = dsin(alph(2))*dcos(omeg(2))
4998 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
4999 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
5000 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
5002 !," --- ", xx_w,yy_w,zz_w
5005 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
5006 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
5008 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
5009 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
5011 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
5012 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
5013 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
5014 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
5015 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
5017 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
5018 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
5019 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
5020 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
5021 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
5023 dsc_i = 0.743d0+x(61)
5025 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5026 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5027 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5028 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5029 s1=(1+x(63))/(0.1d0 + dscp1)
5030 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5031 s2=(1+x(65))/(0.1d0 + dscp2)
5032 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5033 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
5034 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5035 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5037 ! & dscp1,dscp2,sumene
5038 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5039 escloc = escloc + sumene
5040 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5045 ! This section to check the numerical derivatives of the energy of ith side
5046 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5047 ! #define DEBUG in the code to turn it on.
5049 write (2,*) "sumene =",sumene
5053 write (2,*) xx,yy,zz
5054 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5055 de_dxx_num=(sumenep-sumene)/aincr
5057 write (2,*) "xx+ sumene from enesc=",sumenep
5060 write (2,*) xx,yy,zz
5061 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5062 de_dyy_num=(sumenep-sumene)/aincr
5064 write (2,*) "yy+ sumene from enesc=",sumenep
5067 write (2,*) xx,yy,zz
5068 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5069 de_dzz_num=(sumenep-sumene)/aincr
5071 write (2,*) "zz+ sumene from enesc=",sumenep
5072 costsave=cost2tab(i+1)
5073 sintsave=sint2tab(i+1)
5074 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5075 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5076 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5077 de_dt_num=(sumenep-sumene)/aincr
5078 write (2,*) " t+ sumene from enesc=",sumenep
5079 cost2tab(i+1)=costsave
5080 sint2tab(i+1)=sintsave
5081 ! End of diagnostics section.
5084 ! Compute the gradient of esc
5086 ! zz=zz*dsign(1.0,dfloat(itype(i)))
5087 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5088 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5089 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5090 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5091 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5092 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5093 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5094 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5095 pom1=(sumene3*sint2tab(i+1)+sumene1) &
5096 *(pom_s1/dscp1+pom_s16*dscp1**4)
5097 pom2=(sumene4*cost2tab(i+1)+sumene2) &
5098 *(pom_s2/dscp2+pom_s26*dscp2**4)
5099 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5100 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
5101 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
5103 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5104 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
5105 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
5107 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
5108 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
5111 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5114 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5115 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
5116 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
5118 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5119 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
5120 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
5121 +x(59)*zz**2 +x(60)*xx*zz
5122 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
5123 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
5126 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5129 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
5130 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
5131 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
5132 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
5133 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
5134 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
5135 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
5136 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5138 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5141 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
5142 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
5143 +pom1*pom_dt1+pom2*pom_dt2
5145 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5150 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5151 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5152 cosfac2xx=cosfac2*xx
5153 sinfac2yy=sinfac2*yy
5155 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
5157 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
5159 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5160 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5161 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5162 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5163 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5164 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5165 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5166 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5167 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5168 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5172 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
5173 *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5174 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
5175 *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5178 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5179 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5180 dZZ_XYZ(k)=vbld_inv(i+nres)* &
5181 (z_prime(k)-zz*dC_norm(k,i+nres))
5183 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5184 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5188 dXX_Ctab(k,i)=dXX_Ci(k)
5189 dXX_C1tab(k,i)=dXX_Ci1(k)
5190 dYY_Ctab(k,i)=dYY_Ci(k)
5191 dYY_C1tab(k,i)=dYY_Ci1(k)
5192 dZZ_Ctab(k,i)=dZZ_Ci(k)
5193 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5194 dXX_XYZtab(k,i)=dXX_XYZ(k)
5195 dYY_XYZtab(k,i)=dYY_XYZ(k)
5196 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5200 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5201 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5202 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5203 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
5204 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5206 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5207 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5208 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
5209 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5210 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
5211 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5212 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
5213 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5215 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5216 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5218 ! to check gradient call subroutine check_grad
5225 !-----------------------------------------------------------------------------
5226 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
5228 real(kind=8),dimension(65) :: x
5229 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
5230 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5232 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
5233 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
5235 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
5236 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
5238 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
5239 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
5240 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
5241 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
5242 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
5244 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
5245 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
5246 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
5247 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
5248 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
5250 dsc_i = 0.743d0+x(61)
5252 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5253 *(xx*cost2+yy*sint2))
5254 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5255 *(xx*cost2-yy*sint2))
5256 s1=(1+x(63))/(0.1d0 + dscp1)
5257 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5258 s2=(1+x(65))/(0.1d0 + dscp2)
5259 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5260 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
5261 + (sumene4*cost2 +sumene2)*(s2+s2_6)
5266 !-----------------------------------------------------------------------------
5267 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5269 ! This procedure calculates two-body contact function g(rij) and its derivative:
5272 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5275 ! where x=(rij-r0ij)/delta
5277 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5280 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
5281 real(kind=8) :: x,x2,x4,delta
5285 if (x.lt.-1.0D0) then
5288 else if (x.le.1.0D0) then
5291 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5292 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5298 end subroutine gcont
5299 !-----------------------------------------------------------------------------
5300 subroutine splinthet(theti,delta,ss,ssder)
5301 ! implicit real*8 (a-h,o-z)
5302 ! include 'DIMENSIONS'
5303 ! include 'COMMON.VAR'
5304 ! include 'COMMON.GEO'
5305 real(kind=8) :: theti,delta,ss,ssder
5306 real(kind=8) :: thetup,thetlow
5309 if (theti.gt.pipol) then
5310 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5312 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5316 end subroutine splinthet
5317 !-----------------------------------------------------------------------------
5318 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5320 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
5321 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
5322 a1=fprim0*delta/(f1-f0)
5328 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5329 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5331 end subroutine spline1
5332 !-----------------------------------------------------------------------------
5333 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5335 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
5336 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
5341 a2=3*(f1x-f0x)-2*fprim0x*delta
5342 a3=fprim0x*delta-2*(f1x-f0x)
5343 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5345 end subroutine spline2
5346 !-----------------------------------------------------------------------------
5348 !-----------------------------------------------------------------------------
5349 subroutine etor(etors,edihcnstr)
5350 ! implicit real*8 (a-h,o-z)
5351 ! include 'DIMENSIONS'
5352 ! include 'COMMON.VAR'
5353 ! include 'COMMON.GEO'
5354 ! include 'COMMON.LOCAL'
5355 ! include 'COMMON.TORSION'
5356 ! include 'COMMON.INTERACT'
5357 ! include 'COMMON.DERIV'
5358 ! include 'COMMON.CHAIN'
5359 ! include 'COMMON.NAMES'
5360 ! include 'COMMON.IOUNITS'
5361 ! include 'COMMON.FFIELD'
5362 ! include 'COMMON.TORCNSTR'
5363 ! include 'COMMON.CONTROL'
5364 real(kind=8) :: etors,edihcnstr
5368 real(kind=8) :: phii,fac,etors_ii
5370 ! Set lprn=.true. for debugging
5374 do i=iphi_start,iphi_end
5376 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 &
5377 .or. itype(i).eq.ntyp1) cycle
5378 itori=itortyp(itype(i-2))
5379 itori1=itortyp(itype(i-1))
5382 ! Proline-Proline pair is a special case...
5383 if (itori.eq.3 .and. itori1.eq.3) then
5384 if (phii.gt.-dwapi3) then
5386 fac=1.0D0/(1.0D0-cosphi)
5387 etorsi=v1(1,3,3)*fac
5388 etorsi=etorsi+etorsi
5389 etors=etors+etorsi-v1(1,3,3)
5390 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5391 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5394 v1ij=v1(j+1,itori,itori1)
5395 v2ij=v2(j+1,itori,itori1)
5398 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5399 if (energy_dec) etors_ii=etors_ii+ &
5400 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5401 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5405 v1ij=v1(j,itori,itori1)
5406 v2ij=v2(j,itori,itori1)
5409 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5410 if (energy_dec) etors_ii=etors_ii+ &
5411 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5412 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5415 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5418 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5419 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
5420 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5421 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5422 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5424 ! 6/20/98 - dihedral angle constraints
5427 itori=idih_constr(i)
5430 if (difi.gt.drange(i)) then
5432 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5433 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5434 else if (difi.lt.-drange(i)) then
5436 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5437 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5439 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5440 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5442 ! write (iout,*) 'edihcnstr',edihcnstr
5445 !-----------------------------------------------------------------------------
5446 subroutine etor_d(etors_d)
5447 real(kind=8) :: etors_d
5450 end subroutine etor_d
5452 !-----------------------------------------------------------------------------
5453 subroutine etor(etors,edihcnstr)
5454 ! implicit real*8 (a-h,o-z)
5455 ! include 'DIMENSIONS'
5456 ! include 'COMMON.VAR'
5457 ! include 'COMMON.GEO'
5458 ! include 'COMMON.LOCAL'
5459 ! include 'COMMON.TORSION'
5460 ! include 'COMMON.INTERACT'
5461 ! include 'COMMON.DERIV'
5462 ! include 'COMMON.CHAIN'
5463 ! include 'COMMON.NAMES'
5464 ! include 'COMMON.IOUNITS'
5465 ! include 'COMMON.FFIELD'
5466 ! include 'COMMON.TORCNSTR'
5467 ! include 'COMMON.CONTROL'
5468 real(kind=8) :: etors,edihcnstr
5471 integer :: i,j,iblock,itori,itori1
5472 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
5473 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
5474 ! Set lprn=.true. for debugging
5478 do i=iphi_start,iphi_end
5479 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
5480 .or. itype(i).eq.ntyp1) cycle
5482 if (iabs(itype(i)).eq.20) then
5487 itori=itortyp(itype(i-2))
5488 itori1=itortyp(itype(i-1))
5491 ! Regular cosine and sine terms
5492 do j=1,nterm(itori,itori1,iblock)
5493 v1ij=v1(j,itori,itori1,iblock)
5494 v2ij=v2(j,itori,itori1,iblock)
5497 etors=etors+v1ij*cosphi+v2ij*sinphi
5498 if (energy_dec) etors_ii=etors_ii+ &
5499 v1ij*cosphi+v2ij*sinphi
5500 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5504 ! E = SUM ----------------------------------- - v1
5505 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5507 cosphi=dcos(0.5d0*phii)
5508 sinphi=dsin(0.5d0*phii)
5509 do j=1,nlor(itori,itori1,iblock)
5510 vl1ij=vlor1(j,itori,itori1)
5511 vl2ij=vlor2(j,itori,itori1)
5512 vl3ij=vlor3(j,itori,itori1)
5513 pom=vl2ij*cosphi+vl3ij*sinphi
5514 pom1=1.0d0/(pom*pom+1.0d0)
5515 etors=etors+vl1ij*pom1
5516 if (energy_dec) etors_ii=etors_ii+ &
5519 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5521 ! Subtract the constant term
5522 etors=etors-v0(itori,itori1,iblock)
5523 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5524 'etor',i,etors_ii-v0(itori,itori1,iblock)
5526 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5527 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
5528 (v1(j,itori,itori1,iblock),j=1,6),&
5529 (v2(j,itori,itori1,iblock),j=1,6)
5530 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5531 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5533 ! 6/20/98 - dihedral angle constraints
5535 ! do i=1,ndih_constr
5536 do i=idihconstr_start,idihconstr_end
5537 itori=idih_constr(i)
5539 difi=pinorm(phii-phi0(i))
5540 if (difi.gt.drange(i)) then
5542 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5543 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5544 else if (difi.lt.-drange(i)) then
5546 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5547 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5551 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5552 !d & rad2deg*phi0(i), rad2deg*drange(i),
5553 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5555 !d write (iout,*) 'edihcnstr',edihcnstr
5558 !-----------------------------------------------------------------------------
5559 subroutine etor_d(etors_d)
5560 ! 6/23/01 Compute double torsional energy
5561 ! implicit real*8 (a-h,o-z)
5562 ! include 'DIMENSIONS'
5563 ! include 'COMMON.VAR'
5564 ! include 'COMMON.GEO'
5565 ! include 'COMMON.LOCAL'
5566 ! include 'COMMON.TORSION'
5567 ! include 'COMMON.INTERACT'
5568 ! include 'COMMON.DERIV'
5569 ! include 'COMMON.CHAIN'
5570 ! include 'COMMON.NAMES'
5571 ! include 'COMMON.IOUNITS'
5572 ! include 'COMMON.FFIELD'
5573 ! include 'COMMON.TORCNSTR'
5574 real(kind=8) :: etors_d
5577 integer :: i,j,k,l,itori,itori1,itori2,iblock
5578 real(kind=8) :: phii,phii1,gloci1,gloci2,&
5579 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
5580 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
5581 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
5582 ! Set lprn=.true. for debugging
5586 ! write(iout,*) "a tu??"
5587 do i=iphid_start,iphid_end
5588 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
5589 .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5590 itori=itortyp(itype(i-2))
5591 itori1=itortyp(itype(i-1))
5592 itori2=itortyp(itype(i))
5598 if (iabs(itype(i+1)).eq.20) iblock=2
5600 ! Regular cosine and sine terms
5601 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5602 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5603 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5604 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5605 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5606 cosphi1=dcos(j*phii)
5607 sinphi1=dsin(j*phii)
5608 cosphi2=dcos(j*phii1)
5609 sinphi2=dsin(j*phii1)
5610 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
5611 v2cij*cosphi2+v2sij*sinphi2
5612 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5613 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5615 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5617 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5618 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5619 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5620 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5621 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5622 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5623 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5624 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5625 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
5626 v1sdij*sinphi1p2+v2sdij*sinphi1m2
5627 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
5628 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5629 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
5630 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5633 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5634 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5637 end subroutine etor_d
5639 !-----------------------------------------------------------------------------
5640 subroutine eback_sc_corr(esccor)
5641 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
5642 ! conformational states; temporarily implemented as differences
5643 ! between UNRES torsional potentials (dependent on three types of
5644 ! residues) and the torsional potentials dependent on all 20 types
5645 ! of residues computed from AM1 energy surfaces of terminally-blocked
5646 ! amino-acid residues.
5647 ! implicit real*8 (a-h,o-z)
5648 ! include 'DIMENSIONS'
5649 ! include 'COMMON.VAR'
5650 ! include 'COMMON.GEO'
5651 ! include 'COMMON.LOCAL'
5652 ! include 'COMMON.TORSION'
5653 ! include 'COMMON.SCCOR'
5654 ! include 'COMMON.INTERACT'
5655 ! include 'COMMON.DERIV'
5656 ! include 'COMMON.CHAIN'
5657 ! include 'COMMON.NAMES'
5658 ! include 'COMMON.IOUNITS'
5659 ! include 'COMMON.FFIELD'
5660 ! include 'COMMON.CONTROL'
5661 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
5664 integer :: i,interty,j,isccori,isccori1,intertyp
5665 ! Set lprn=.true. for debugging
5668 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5670 do i=itau_start,itau_end
5671 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5673 isccori=isccortyp(itype(i-2))
5674 isccori1=isccortyp(itype(i-1))
5675 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5677 do intertyp=1,3 !intertyp
5678 !c Added 09 May 2012 (Adasko)
5679 !c Intertyp means interaction type of backbone mainchain correlation:
5680 ! 1 = SC...Ca...Ca...Ca
5681 ! 2 = Ca...Ca...Ca...SC
5682 ! 3 = SC...Ca...Ca...SCi
5684 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. &
5685 (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or. &
5686 (itype(i-1).eq.ntyp1))) &
5687 .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) &
5688 .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1) &
5689 .or.(itype(i).eq.ntyp1))) &
5690 .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. &
5691 (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. &
5692 (itype(i-3).eq.ntyp1)))) cycle
5693 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5694 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1)) &
5696 do j=1,nterm_sccor(isccori,isccori1)
5697 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5698 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5699 cosphi=dcos(j*tauangle(intertyp,i))
5700 sinphi=dsin(j*tauangle(intertyp,i))
5701 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5702 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5704 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5705 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5707 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5708 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,&
5709 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
5710 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5711 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5716 end subroutine eback_sc_corr
5717 !-----------------------------------------------------------------------------
5718 subroutine multibody(ecorr)
5719 ! This subroutine calculates multi-body contributions to energy following
5720 ! the idea of Skolnick et al. If side chains I and J make a contact and
5721 ! at the same time side chains I+1 and J+1 make a contact, an extra
5722 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5723 ! implicit real*8 (a-h,o-z)
5724 ! include 'DIMENSIONS'
5725 ! include 'COMMON.IOUNITS'
5726 ! include 'COMMON.DERIV'
5727 ! include 'COMMON.INTERACT'
5728 ! include 'COMMON.CONTACTS'
5729 real(kind=8),dimension(3) :: gx,gx1
5731 real(kind=8) :: ecorr
5732 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
5733 ! Set lprn=.true. for debugging
5737 write (iout,'(a)') 'Contact function values:'
5739 write (iout,'(i2,20(1x,i2,f10.5))') &
5740 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5745 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
5746 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
5758 num_conti=num_cont(i)
5759 num_conti1=num_cont(i1)
5764 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5765 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5766 !d & ' ishift=',ishift
5767 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5768 ! The system gains extra energy.
5769 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5770 endif ! j1==j+-ishift
5778 end subroutine multibody
5779 !-----------------------------------------------------------------------------
5780 real(kind=8) function esccorr(i,j,k,l,jj,kk)
5781 ! implicit real*8 (a-h,o-z)
5782 ! include 'DIMENSIONS'
5783 ! include 'COMMON.IOUNITS'
5784 ! include 'COMMON.DERIV'
5785 ! include 'COMMON.INTERACT'
5786 ! include 'COMMON.CONTACTS'
5787 real(kind=8),dimension(3) :: gx,gx1
5789 integer :: i,j,k,l,jj,kk,m,ll
5790 real(kind=8) :: eij,ekl
5794 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5795 ! Calculate the multi-body contribution to energy.
5796 ! Calculate multi-body contributions to the gradient.
5797 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5798 !d & k,l,(gacont(m,kk,k),m=1,3)
5800 gx(m) =ekl*gacont(m,jj,i)
5801 gx1(m)=eij*gacont(m,kk,k)
5802 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5803 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5804 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5805 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5809 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5814 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5819 end function esccorr
5820 !-----------------------------------------------------------------------------
5821 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5822 ! This subroutine calculates multi-body contributions to hydrogen-bonding
5823 ! implicit real*8 (a-h,o-z)
5824 ! include 'DIMENSIONS'
5825 ! include 'COMMON.IOUNITS'
5828 ! integer :: maxconts !max_cont=maxconts =nres/4
5829 integer,parameter :: max_dim=26
5830 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5831 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
5832 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
5833 !el common /przechowalnia/ zapas
5834 integer :: status(MPI_STATUS_SIZE)
5835 integer,dimension((nres/4)*2) :: req !maxconts*2
5836 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
5838 ! include 'COMMON.SETUP'
5839 ! include 'COMMON.FFIELD'
5840 ! include 'COMMON.DERIV'
5841 ! include 'COMMON.INTERACT'
5842 ! include 'COMMON.CONTACTS'
5843 ! include 'COMMON.CONTROL'
5844 ! include 'COMMON.LOCAL'
5845 real(kind=8),dimension(3) :: gx,gx1
5846 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
5847 logical :: lprn,ldone
5849 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
5850 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
5852 ! Set lprn=.true. for debugging
5856 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
5859 if (nfgtasks.le.1) goto 30
5861 write (iout,'(a)') 'Contact function values before RECEIVE:'
5863 write (iout,'(2i3,50(1x,i2,f5.2))') &
5864 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
5869 do i=1,ntask_cont_from
5872 do i=1,ntask_cont_to
5875 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5877 ! Make the list of contacts to send to send to other procesors
5878 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5880 do i=iturn3_start,iturn3_end
5881 ! write (iout,*) "make contact list turn3",i," num_cont",
5883 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5885 do i=iturn4_start,iturn4_end
5886 ! write (iout,*) "make contact list turn4",i," num_cont",
5888 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5892 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
5894 do j=1,num_cont_hb(i)
5897 iproc=iint_sent_local(k,jjc,ii)
5898 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5899 if (iproc.gt.0) then
5900 ncont_sent(iproc)=ncont_sent(iproc)+1
5901 nn=ncont_sent(iproc)
5903 zapas(2,nn,iproc)=jjc
5904 zapas(3,nn,iproc)=facont_hb(j,i)
5905 zapas(4,nn,iproc)=ees0p(j,i)
5906 zapas(5,nn,iproc)=ees0m(j,i)
5907 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5908 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5909 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5910 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5911 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5912 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5913 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5914 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5915 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5916 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5917 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
5918 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
5919 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
5920 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
5921 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
5922 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
5923 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
5924 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
5925 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
5926 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
5927 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
5934 "Numbers of contacts to be sent to other processors",&
5935 (ncont_sent(i),i=1,ntask_cont_to)
5936 write (iout,*) "Contacts sent"
5937 do ii=1,ntask_cont_to
5939 iproc=itask_cont_to(ii)
5940 write (iout,*) nn," contacts to processor",iproc,&
5941 " of CONT_TO_COMM group"
5943 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
5951 CorrelID1=nfgtasks+fg_rank+1
5953 ! Receive the numbers of needed contacts from other processors
5954 do ii=1,ntask_cont_from
5955 iproc=itask_cont_from(ii)
5957 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
5958 FG_COMM,req(ireq),IERR)
5960 ! write (iout,*) "IRECV ended"
5962 ! Send the number of contacts needed by other processors
5963 do ii=1,ntask_cont_to
5964 iproc=itask_cont_to(ii)
5966 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
5967 FG_COMM,req(ireq),IERR)
5969 ! write (iout,*) "ISEND ended"
5970 ! write (iout,*) "number of requests (nn)",ireq
5973 call MPI_Waitall(ireq,req,status_array,ierr)
5975 ! & "Numbers of contacts to be received from other processors",
5976 ! & (ncont_recv(i),i=1,ntask_cont_from)
5980 do ii=1,ntask_cont_from
5981 iproc=itask_cont_from(ii)
5983 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
5984 ! & " of CONT_TO_COMM group"
5988 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
5989 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
5990 ! write (iout,*) "ireq,req",ireq,req(ireq)
5993 ! Send the contacts to processors that need them
5994 do ii=1,ntask_cont_to
5995 iproc=itask_cont_to(ii)
5997 ! write (iout,*) nn," contacts to processor",iproc,
5998 ! & " of CONT_TO_COMM group"
6001 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
6002 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6003 ! write (iout,*) "ireq,req",ireq,req(ireq)
6005 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6009 ! write (iout,*) "number of requests (contacts)",ireq
6010 ! write (iout,*) "req",(req(i),i=1,4)
6013 call MPI_Waitall(ireq,req,status_array,ierr)
6014 do iii=1,ntask_cont_from
6015 iproc=itask_cont_from(iii)
6018 write (iout,*) "Received",nn," contacts from processor",iproc,&
6019 " of CONT_FROM_COMM group"
6022 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6027 ii=zapas_recv(1,i,iii)
6028 ! Flag the received contacts to prevent double-counting
6029 jj=-zapas_recv(2,i,iii)
6030 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6032 nnn=num_cont_hb(ii)+1
6035 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6036 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6037 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6038 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6039 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6040 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6041 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6042 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6043 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6044 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6045 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6046 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6047 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6048 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6049 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6050 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6051 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6052 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6053 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6054 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6055 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6056 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6057 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6058 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6063 write (iout,'(a)') 'Contact function values after receive:'
6065 write (iout,'(2i3,50(1x,i3,f5.2))') &
6066 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6074 write (iout,'(a)') 'Contact function values:'
6076 write (iout,'(2i3,50(1x,i3,f5.2))') &
6077 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6083 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6084 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6085 ! Remove the loop below after debugging !!!
6092 ! Calculate the local-electrostatic correlation terms
6093 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6095 num_conti=num_cont_hb(i)
6096 num_conti1=num_cont_hb(i+1)
6103 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
6104 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
6105 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
6106 .or. j.lt.0 .and. j1.gt.0) .and. &
6107 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6108 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6109 ! The system gains extra energy.
6110 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6111 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
6112 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6114 else if (j1.eq.j) then
6115 ! Contacts I-J and I-(J+1) occur simultaneously.
6116 ! The system loses extra energy.
6117 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6122 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6123 ! & ' jj=',jj,' kk=',kk
6125 ! Contacts I-J and (I+1)-J occur simultaneously.
6126 ! The system loses extra energy.
6127 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6133 end subroutine multibody_hb
6134 !-----------------------------------------------------------------------------
6135 subroutine add_hb_contact(ii,jj,itask)
6136 ! implicit real*8 (a-h,o-z)
6137 ! include "DIMENSIONS"
6138 ! include "COMMON.IOUNITS"
6139 ! include "COMMON.CONTACTS"
6140 ! integer,parameter :: maxconts=nres/4
6141 integer,parameter :: max_dim=26
6142 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6143 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
6144 ! common /przechowalnia/ zapas
6145 integer :: i,j,ii,jj,iproc,nn,jjc
6146 integer,dimension(4) :: itask
6147 ! write (iout,*) "itask",itask
6150 if (iproc.gt.0) then
6151 do j=1,num_cont_hb(ii)
6153 ! write (iout,*) "i",ii," j",jj," jjc",jjc
6155 ncont_sent(iproc)=ncont_sent(iproc)+1
6156 nn=ncont_sent(iproc)
6157 zapas(1,nn,iproc)=ii
6158 zapas(2,nn,iproc)=jjc
6159 zapas(3,nn,iproc)=facont_hb(j,ii)
6160 zapas(4,nn,iproc)=ees0p(j,ii)
6161 zapas(5,nn,iproc)=ees0m(j,ii)
6162 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6163 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6164 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6165 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6166 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6167 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6168 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6169 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6170 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6171 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6172 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6173 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6174 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6175 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6176 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6177 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6178 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6179 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6180 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6181 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6182 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6189 end subroutine add_hb_contact
6190 !-----------------------------------------------------------------------------
6191 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
6192 ! This subroutine calculates multi-body contributions to hydrogen-bonding
6193 ! implicit real*8 (a-h,o-z)
6194 ! include 'DIMENSIONS'
6195 ! include 'COMMON.IOUNITS'
6196 integer,parameter :: max_dim=70
6199 ! integer :: maxconts !max_cont=maxconts=nres/4
6200 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6201 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
6202 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6203 ! common /przechowalnia/ zapas
6204 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
6205 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
6208 ! include 'COMMON.SETUP'
6209 ! include 'COMMON.FFIELD'
6210 ! include 'COMMON.DERIV'
6211 ! include 'COMMON.LOCAL'
6212 ! include 'COMMON.INTERACT'
6213 ! include 'COMMON.CONTACTS'
6214 ! include 'COMMON.CHAIN'
6215 ! include 'COMMON.CONTROL'
6216 real(kind=8),dimension(3) :: gx,gx1
6217 integer,dimension(nres) :: num_cont_hb_old
6218 logical :: lprn,ldone
6219 !EL double precision eello4,eello5,eelo6,eello_turn6
6220 !EL external eello4,eello5,eello6,eello_turn6
6222 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
6223 j1,jp1,i1,num_conti1
6224 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
6225 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
6227 ! Set lprn=.true. for debugging
6232 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
6234 num_cont_hb_old(i)=num_cont_hb(i)
6238 if (nfgtasks.le.1) goto 30
6240 write (iout,'(a)') 'Contact function values before RECEIVE:'
6242 write (iout,'(2i3,50(1x,i2,f5.2))') &
6243 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6248 do i=1,ntask_cont_from
6251 do i=1,ntask_cont_to
6254 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6256 ! Make the list of contacts to send to send to other procesors
6257 do i=iturn3_start,iturn3_end
6258 ! write (iout,*) "make contact list turn3",i," num_cont",
6260 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6262 do i=iturn4_start,iturn4_end
6263 ! write (iout,*) "make contact list turn4",i," num_cont",
6265 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6269 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
6271 do j=1,num_cont_hb(i)
6274 iproc=iint_sent_local(k,jjc,ii)
6275 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6276 if (iproc.ne.0) then
6277 ncont_sent(iproc)=ncont_sent(iproc)+1
6278 nn=ncont_sent(iproc)
6280 zapas(2,nn,iproc)=jjc
6281 zapas(3,nn,iproc)=d_cont(j,i)
6285 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6290 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6298 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6309 "Numbers of contacts to be sent to other processors",&
6310 (ncont_sent(i),i=1,ntask_cont_to)
6311 write (iout,*) "Contacts sent"
6312 do ii=1,ntask_cont_to
6314 iproc=itask_cont_to(ii)
6315 write (iout,*) nn," contacts to processor",iproc,&
6316 " of CONT_TO_COMM group"
6318 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6326 CorrelID1=nfgtasks+fg_rank+1
6328 ! Receive the numbers of needed contacts from other processors
6329 do ii=1,ntask_cont_from
6330 iproc=itask_cont_from(ii)
6332 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
6333 FG_COMM,req(ireq),IERR)
6335 ! write (iout,*) "IRECV ended"
6337 ! Send the number of contacts needed by other processors
6338 do ii=1,ntask_cont_to
6339 iproc=itask_cont_to(ii)
6341 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
6342 FG_COMM,req(ireq),IERR)
6344 ! write (iout,*) "ISEND ended"
6345 ! write (iout,*) "number of requests (nn)",ireq
6348 call MPI_Waitall(ireq,req,status_array,ierr)
6350 ! & "Numbers of contacts to be received from other processors",
6351 ! & (ncont_recv(i),i=1,ntask_cont_from)
6355 do ii=1,ntask_cont_from
6356 iproc=itask_cont_from(ii)
6358 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
6359 ! & " of CONT_TO_COMM group"
6363 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
6364 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6365 ! write (iout,*) "ireq,req",ireq,req(ireq)
6368 ! Send the contacts to processors that need them
6369 do ii=1,ntask_cont_to
6370 iproc=itask_cont_to(ii)
6372 ! write (iout,*) nn," contacts to processor",iproc,
6373 ! & " of CONT_TO_COMM group"
6376 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
6377 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6378 ! write (iout,*) "ireq,req",ireq,req(ireq)
6380 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6384 ! write (iout,*) "number of requests (contacts)",ireq
6385 ! write (iout,*) "req",(req(i),i=1,4)
6388 call MPI_Waitall(ireq,req,status_array,ierr)
6389 do iii=1,ntask_cont_from
6390 iproc=itask_cont_from(iii)
6393 write (iout,*) "Received",nn," contacts from processor",iproc,&
6394 " of CONT_FROM_COMM group"
6397 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6402 ii=zapas_recv(1,i,iii)
6403 ! Flag the received contacts to prevent double-counting
6404 jj=-zapas_recv(2,i,iii)
6405 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6407 nnn=num_cont_hb(ii)+1
6410 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6414 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6419 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6427 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6436 write (iout,'(a)') 'Contact function values after receive:'
6438 write (iout,'(2i3,50(1x,i3,5f6.3))') &
6439 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
6440 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6447 write (iout,'(a)') 'Contact function values:'
6449 write (iout,'(2i3,50(1x,i2,5f6.3))') &
6450 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
6451 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6458 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6459 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6460 ! Remove the loop below after debugging !!!
6467 ! Calculate the dipole-dipole interaction energies
6468 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6469 do i=iatel_s,iatel_e+1
6470 num_conti=num_cont_hb(i)
6479 ! Calculate the local-electrostatic correlation terms
6480 ! write (iout,*) "gradcorr5 in eello5 before loop"
6482 ! write (iout,'(i5,3f10.5)')
6483 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6485 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6486 ! write (iout,*) "corr loop i",i
6488 num_conti=num_cont_hb(i)
6489 num_conti1=num_cont_hb(i+1)
6496 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6497 ! & ' jj=',jj,' kk=',kk
6498 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
6499 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
6500 .or. j.lt.0 .and. j1.gt.0) .and. &
6501 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6502 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6503 ! The system gains extra energy.
6505 sqd1=dsqrt(d_cont(jj,i))
6506 sqd2=dsqrt(d_cont(kk,i1))
6507 sred_geom = sqd1*sqd2
6508 IF (sred_geom.lt.cutoff_corr) THEN
6509 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
6511 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6512 !d & ' jj=',jj,' kk=',kk
6513 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6514 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6516 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6517 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6520 !d write (iout,*) 'sred_geom=',sred_geom,
6521 !d & ' ekont=',ekont,' fprim=',fprimcont,
6522 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6523 !d write (iout,*) "g_contij",g_contij
6524 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6525 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6526 call calc_eello(i,jp,i+1,jp1,jj,kk)
6527 if (wcorr4.gt.0.0d0) &
6528 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6529 if (energy_dec.and.wcorr4.gt.0.0d0) &
6530 write (iout,'(a6,4i5,0pf7.3)') &
6531 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6532 ! write (iout,*) "gradcorr5 before eello5"
6534 ! write (iout,'(i5,3f10.5)')
6535 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6537 if (wcorr5.gt.0.0d0) &
6538 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6539 ! write (iout,*) "gradcorr5 after eello5"
6541 ! write (iout,'(i5,3f10.5)')
6542 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6544 if (energy_dec.and.wcorr5.gt.0.0d0) &
6545 write (iout,'(a6,4i5,0pf7.3)') &
6546 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6547 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6548 !d write(2,*)'ijkl',i,jp,i+1,jp1
6549 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
6550 .or. wturn6.eq.0.0d0))then
6551 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6552 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6553 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
6554 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6555 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6556 !d & 'ecorr6=',ecorr6
6557 !d write (iout,'(4e15.5)') sred_geom,
6558 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6559 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6560 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6561 else if (wturn6.gt.0.0d0 &
6562 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6563 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6564 eturn6=eturn6+eello_turn6(i,jj,kk)
6565 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
6566 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6567 !d write (2,*) 'multibody_eello:eturn6',eturn6
6576 num_cont_hb(i)=num_cont_hb_old(i)
6578 ! write (iout,*) "gradcorr5 in eello5"
6580 ! write (iout,'(i5,3f10.5)')
6581 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6584 end subroutine multibody_eello
6585 !-----------------------------------------------------------------------------
6586 subroutine add_hb_contact_eello(ii,jj,itask)
6587 ! implicit real*8 (a-h,o-z)
6588 ! include "DIMENSIONS"
6589 ! include "COMMON.IOUNITS"
6590 ! include "COMMON.CONTACTS"
6591 ! integer,parameter :: maxconts=nres/4
6592 integer,parameter :: max_dim=70
6593 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
6594 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6595 ! common /przechowalnia/ zapas
6597 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
6598 integer,dimension(4) ::itask
6599 ! write (iout,*) "itask",itask
6602 if (iproc.gt.0) then
6603 do j=1,num_cont_hb(ii)
6605 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6607 ncont_sent(iproc)=ncont_sent(iproc)+1
6608 nn=ncont_sent(iproc)
6609 zapas(1,nn,iproc)=ii
6610 zapas(2,nn,iproc)=jjc
6611 zapas(3,nn,iproc)=d_cont(j,ii)
6615 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6620 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6628 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6639 end subroutine add_hb_contact_eello
6640 !-----------------------------------------------------------------------------
6641 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6642 ! implicit real*8 (a-h,o-z)
6643 ! include 'DIMENSIONS'
6644 ! include 'COMMON.IOUNITS'
6645 ! include 'COMMON.DERIV'
6646 ! include 'COMMON.INTERACT'
6647 ! include 'COMMON.CONTACTS'
6648 real(kind=8),dimension(3) :: gx,gx1
6651 integer :: i,j,k,l,jj,kk,ll
6652 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
6653 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
6654 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl
6664 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6665 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6666 ! Following 4 lines for diagnostics.
6671 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6672 ! & 'Contacts ',i,j,
6673 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6674 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6676 ! Calculate the multi-body contribution to energy.
6677 ! ecorr=ecorr+ekont*ees
6678 ! Calculate multi-body contributions to the gradient.
6679 coeffpees0pij=coeffp*ees0pij
6680 coeffmees0mij=coeffm*ees0mij
6681 coeffpees0pkl=coeffp*ees0pkl
6682 coeffmees0mkl=coeffm*ees0mkl
6684 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6685 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
6686 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
6687 coeffmees0mkl*gacontm_hb1(ll,jj,i))
6688 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
6689 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
6690 coeffmees0mkl*gacontm_hb2(ll,jj,i))
6691 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6692 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
6693 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
6694 coeffmees0mij*gacontm_hb1(ll,kk,k))
6695 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
6696 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
6697 coeffmees0mij*gacontm_hb2(ll,kk,k))
6698 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
6699 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
6700 coeffmees0mkl*gacontm_hb3(ll,jj,i))
6701 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6702 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6703 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
6704 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
6705 coeffmees0mij*gacontm_hb3(ll,kk,k))
6706 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6707 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6708 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6713 !grad gradcorr(ll,m)=gradcorr(ll,m)+
6714 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
6715 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6716 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6721 !grad gradcorr(ll,m)=gradcorr(ll,m)+
6722 !grad & ees*eij*gacont_hbr(ll,kk,k)-
6723 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6724 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6727 ! write (iout,*) "ehbcorr",ekont*ees
6730 end function ehbcorr
6732 !-----------------------------------------------------------------------------
6733 subroutine dipole(i,j,jj)
6734 ! implicit real*8 (a-h,o-z)
6735 ! include 'DIMENSIONS'
6736 ! include 'COMMON.IOUNITS'
6737 ! include 'COMMON.CHAIN'
6738 ! include 'COMMON.FFIELD'
6739 ! include 'COMMON.DERIV'
6740 ! include 'COMMON.INTERACT'
6741 ! include 'COMMON.CONTACTS'
6742 ! include 'COMMON.TORSION'
6743 ! include 'COMMON.VAR'
6744 ! include 'COMMON.GEO'
6745 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
6746 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
6747 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
6749 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
6750 allocate(dipderx(3,5,4,maxconts,nres))
6753 iti1 = itortyp(itype(i+1))
6754 if (j.lt.nres-1) then
6755 itj1 = itortyp(itype(j+1))
6760 dipi(iii,1)=Ub2(iii,i)
6761 dipderi(iii)=Ub2der(iii,i)
6762 dipi(iii,2)=b1(iii,iti1)
6763 dipj(iii,1)=Ub2(iii,j)
6764 dipderj(iii)=Ub2der(iii,j)
6765 dipj(iii,2)=b1(iii,itj1)
6769 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6772 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6779 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
6783 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6788 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6789 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6791 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6793 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6795 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6798 end subroutine dipole
6800 !-----------------------------------------------------------------------------
6801 subroutine calc_eello(i,j,k,l,jj,kk)
6803 ! This subroutine computes matrices and vectors needed to calculate
6804 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
6807 ! implicit real*8 (a-h,o-z)
6808 ! include 'DIMENSIONS'
6809 ! include 'COMMON.IOUNITS'
6810 ! include 'COMMON.CHAIN'
6811 ! include 'COMMON.DERIV'
6812 ! include 'COMMON.INTERACT'
6813 ! include 'COMMON.CONTACTS'
6814 ! include 'COMMON.TORSION'
6815 ! include 'COMMON.VAR'
6816 ! include 'COMMON.GEO'
6817 ! include 'COMMON.FFIELD'
6818 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
6819 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
6820 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
6823 !el common /kutas/ lprn
6824 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6825 !d & ' jj=',jj,' kk=',kk
6826 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6827 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6828 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6831 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6832 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6835 call transpose2(aa1(1,1),aa1t(1,1))
6836 call transpose2(aa2(1,1),aa2t(1,1))
6839 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
6840 aa1tder(1,1,lll,kkk))
6841 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
6842 aa2tder(1,1,lll,kkk))
6846 ! parallel orientation of the two CA-CA-CA frames.
6848 iti=itortyp(itype(i))
6852 itk1=itortyp(itype(k+1))
6853 itj=itortyp(itype(j))
6854 if (l.lt.nres-1) then
6855 itl1=itortyp(itype(l+1))
6859 ! A1 kernel(j+1) A2T
6861 !d write (iout,'(3f10.5,5x,3f10.5)')
6862 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6864 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
6865 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
6866 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6867 ! Following matrices are needed only for 6-th order cumulants
6868 IF (wcorr6.gt.0.0d0) THEN
6869 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
6870 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
6871 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6872 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
6873 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
6874 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
6875 ADtEAderx(1,1,1,1,1,1))
6877 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
6878 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
6879 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
6880 ADtEA1derx(1,1,1,1,1,1))
6882 ! End 6-th order cumulants
6885 !d write (2,*) 'In calc_eello6'
6887 !d write (2,*) 'iii=',iii
6889 !d write (2,*) 'kkk=',kkk
6891 !d write (2,'(3(2f10.5),5x)')
6892 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6897 call transpose2(EUgder(1,1,k),auxmat(1,1))
6898 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6899 call transpose2(EUg(1,1,k),auxmat(1,1))
6900 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6901 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6905 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
6906 EAEAderx(1,1,lll,kkk,iii,1))
6910 ! A1T kernel(i+1) A2
6911 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
6912 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
6913 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6914 ! Following matrices are needed only for 6-th order cumulants
6915 IF (wcorr6.gt.0.0d0) THEN
6916 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
6917 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
6918 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6919 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
6920 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
6921 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
6922 ADtEAderx(1,1,1,1,1,2))
6923 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
6924 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
6925 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
6926 ADtEA1derx(1,1,1,1,1,2))
6928 ! End 6-th order cumulants
6929 call transpose2(EUgder(1,1,l),auxmat(1,1))
6930 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6931 call transpose2(EUg(1,1,l),auxmat(1,1))
6932 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6933 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6937 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
6938 EAEAderx(1,1,lll,kkk,iii,2))
6943 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6944 ! They are needed only when the fifth- or the sixth-order cumulants are
6946 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6947 call transpose2(AEA(1,1,1),auxmat(1,1))
6948 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6949 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6950 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6951 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6952 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6953 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6954 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6955 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6956 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6957 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6958 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6959 call transpose2(AEA(1,1,2),auxmat(1,1))
6960 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6961 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6962 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6963 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6964 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6965 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6966 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6967 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6968 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6969 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6970 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6971 ! Calculate the Cartesian derivatives of the vectors.
6975 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6976 call matvec2(auxmat(1,1),b1(1,iti),&
6977 AEAb1derx(1,lll,kkk,iii,1,1))
6978 call matvec2(auxmat(1,1),Ub2(1,i),&
6979 AEAb2derx(1,lll,kkk,iii,1,1))
6980 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
6981 AEAb1derx(1,lll,kkk,iii,2,1))
6982 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
6983 AEAb2derx(1,lll,kkk,iii,2,1))
6984 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6985 call matvec2(auxmat(1,1),b1(1,itj),&
6986 AEAb1derx(1,lll,kkk,iii,1,2))
6987 call matvec2(auxmat(1,1),Ub2(1,j),&
6988 AEAb2derx(1,lll,kkk,iii,1,2))
6989 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
6990 AEAb1derx(1,lll,kkk,iii,2,2))
6991 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
6992 AEAb2derx(1,lll,kkk,iii,2,2))
6999 ! Antiparallel orientation of the two CA-CA-CA frames.
7001 iti=itortyp(itype(i))
7005 itk1=itortyp(itype(k+1))
7006 itl=itortyp(itype(l))
7007 itj=itortyp(itype(j))
7008 if (j.lt.nres-1) then
7009 itj1=itortyp(itype(j+1))
7013 ! A2 kernel(j-1)T A1T
7014 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7015 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
7016 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7017 ! Following matrices are needed only for 6-th order cumulants
7018 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
7019 j.eq.i+4 .and. l.eq.i+3)) THEN
7020 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7021 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
7022 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7023 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7024 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
7025 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
7026 ADtEAderx(1,1,1,1,1,1))
7027 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7028 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
7029 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
7030 ADtEA1derx(1,1,1,1,1,1))
7032 ! End 6-th order cumulants
7033 call transpose2(EUgder(1,1,k),auxmat(1,1))
7034 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7035 call transpose2(EUg(1,1,k),auxmat(1,1))
7036 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7037 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7041 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7042 EAEAderx(1,1,lll,kkk,iii,1))
7046 ! A2T kernel(i+1)T A1
7047 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7048 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
7049 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7050 ! Following matrices are needed only for 6-th order cumulants
7051 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
7052 j.eq.i+4 .and. l.eq.i+3)) THEN
7053 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7054 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
7055 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7056 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7057 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
7058 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
7059 ADtEAderx(1,1,1,1,1,2))
7060 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7061 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
7062 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
7063 ADtEA1derx(1,1,1,1,1,2))
7065 ! End 6-th order cumulants
7066 call transpose2(EUgder(1,1,j),auxmat(1,1))
7067 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7068 call transpose2(EUg(1,1,j),auxmat(1,1))
7069 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7070 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7074 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7075 EAEAderx(1,1,lll,kkk,iii,2))
7080 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7081 ! They are needed only when the fifth- or the sixth-order cumulants are
7083 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
7084 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7085 call transpose2(AEA(1,1,1),auxmat(1,1))
7086 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7087 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7088 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7089 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7090 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7091 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7092 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7093 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7094 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7095 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7096 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7097 call transpose2(AEA(1,1,2),auxmat(1,1))
7098 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7099 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7100 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7101 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7102 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7103 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7104 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7105 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7106 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7107 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7108 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7109 ! Calculate the Cartesian derivatives of the vectors.
7113 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7114 call matvec2(auxmat(1,1),b1(1,iti),&
7115 AEAb1derx(1,lll,kkk,iii,1,1))
7116 call matvec2(auxmat(1,1),Ub2(1,i),&
7117 AEAb2derx(1,lll,kkk,iii,1,1))
7118 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
7119 AEAb1derx(1,lll,kkk,iii,2,1))
7120 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
7121 AEAb2derx(1,lll,kkk,iii,2,1))
7122 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7123 call matvec2(auxmat(1,1),b1(1,itl),&
7124 AEAb1derx(1,lll,kkk,iii,1,2))
7125 call matvec2(auxmat(1,1),Ub2(1,l),&
7126 AEAb2derx(1,lll,kkk,iii,1,2))
7127 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
7128 AEAb1derx(1,lll,kkk,iii,2,2))
7129 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
7130 AEAb2derx(1,lll,kkk,iii,2,2))
7138 end subroutine calc_eello
7139 !-----------------------------------------------------------------------------
7140 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
7145 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
7146 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
7147 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
7148 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
7149 integer :: iii,kkk,lll
7152 !el common /kutas/ lprn
7153 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7155 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
7158 !d if (lprn) write (2,*) 'In kernel'
7160 !d if (lprn) write (2,*) 'kkk=',kkk
7162 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
7163 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7165 !d write (2,*) 'lll=',lll
7166 !d write (2,*) 'iii=1'
7168 !d write (2,'(3(2f10.5),5x)')
7169 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7172 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
7173 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7175 !d write (2,*) 'lll=',lll
7176 !d write (2,*) 'iii=2'
7178 !d write (2,'(3(2f10.5),5x)')
7179 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7185 end subroutine kernel
7186 !-----------------------------------------------------------------------------
7187 real(kind=8) function eello4(i,j,k,l,jj,kk)
7188 ! implicit real*8 (a-h,o-z)
7189 ! include 'DIMENSIONS'
7190 ! include 'COMMON.IOUNITS'
7191 ! include 'COMMON.CHAIN'
7192 ! include 'COMMON.DERIV'
7193 ! include 'COMMON.INTERACT'
7194 ! include 'COMMON.CONTACTS'
7195 ! include 'COMMON.TORSION'
7196 ! include 'COMMON.VAR'
7197 ! include 'COMMON.GEO'
7198 real(kind=8),dimension(2,2) :: pizda
7199 real(kind=8),dimension(3) :: ggg1,ggg2
7200 real(kind=8) :: eel4,glongij,glongkl
7201 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
7202 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7206 !d print *,'eello4:',i,j,k,l,jj,kk
7207 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
7208 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
7209 !old eij=facont_hb(jj,i)
7210 !old ekl=facont_hb(kk,k)
7212 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7213 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7214 gcorr_loc(k-1)=gcorr_loc(k-1) &
7215 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7217 gcorr_loc(l-1)=gcorr_loc(l-1) &
7218 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7220 gcorr_loc(j-1)=gcorr_loc(j-1) &
7221 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7226 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
7227 -EAEAderx(2,2,lll,kkk,iii,1)
7228 !d derx(lll,kkk,iii)=0.0d0
7232 !d gcorr_loc(l-1)=0.0d0
7233 !d gcorr_loc(j-1)=0.0d0
7234 !d gcorr_loc(k-1)=0.0d0
7236 !d write (iout,*)'Contacts have occurred for peptide groups',
7237 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
7238 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7239 if (j.lt.nres-1) then
7246 if (l.lt.nres-1) then
7254 !grad ggg1(ll)=eel4*g_contij(ll,1)
7255 !grad ggg2(ll)=eel4*g_contij(ll,2)
7256 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7257 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7258 !grad ghalf=0.5d0*ggg1(ll)
7259 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7260 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7261 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7262 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7263 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7264 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7265 !grad ghalf=0.5d0*ggg2(ll)
7266 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7267 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7268 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7269 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7270 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7271 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7275 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7280 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7285 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7290 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7294 !d write (2,*) iii,gcorr_loc(iii)
7297 !d write (2,*) 'ekont',ekont
7298 !d write (iout,*) 'eello4',ekont*eel4
7301 !-----------------------------------------------------------------------------
7302 real(kind=8) function eello5(i,j,k,l,jj,kk)
7303 ! implicit real*8 (a-h,o-z)
7304 ! include 'DIMENSIONS'
7305 ! include 'COMMON.IOUNITS'
7306 ! include 'COMMON.CHAIN'
7307 ! include 'COMMON.DERIV'
7308 ! include 'COMMON.INTERACT'
7309 ! include 'COMMON.CONTACTS'
7310 ! include 'COMMON.TORSION'
7311 ! include 'COMMON.VAR'
7312 ! include 'COMMON.GEO'
7313 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
7314 real(kind=8),dimension(2) :: vv
7315 real(kind=8),dimension(3) :: ggg1,ggg2
7316 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
7317 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
7318 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
7319 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7324 ! /l\ / \ \ / \ / \ / C
7325 ! / \ / \ \ / \ / \ / C
7326 ! j| o |l1 | o | o| o | | o |o C
7327 ! \ |/k\| |/ \| / |/ \| |/ \| C
7328 ! \i/ \ / \ / / \ / \ C
7330 ! (I) (II) (III) (IV) C
7332 ! eello5_1 eello5_2 eello5_3 eello5_4 C
7334 ! Antiparallel chains C
7337 ! /j\ / \ \ / \ / \ / C
7338 ! / \ / \ \ / \ / \ / C
7339 ! j1| o |l | o | o| o | | o |o C
7340 ! \ |/k\| |/ \| / |/ \| |/ \| C
7341 ! \i/ \ / \ / / \ / \ C
7343 ! (I) (II) (III) (IV) C
7345 ! eello5_1 eello5_2 eello5_3 eello5_4 C
7347 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
7349 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7350 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7355 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7357 itk=itortyp(itype(k))
7358 itl=itortyp(itype(l))
7359 itj=itortyp(itype(j))
7364 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7365 !d & eel5_3_num,eel5_4_num)
7369 derx(lll,kkk,iii)=0.0d0
7373 !d eij=facont_hb(jj,i)
7374 !d ekl=facont_hb(kk,k)
7376 !d write (iout,*)'Contacts have occurred for peptide groups',
7377 !d & i,j,' fcont:',eij,' eij',' and ',k,l
7379 ! Contribution from the graph I.
7380 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7381 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7382 call transpose2(EUg(1,1,k),auxmat(1,1))
7383 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7384 vv(1)=pizda(1,1)-pizda(2,2)
7385 vv(2)=pizda(1,2)+pizda(2,1)
7386 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
7387 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7388 ! Explicit gradient in virtual-dihedral angles.
7389 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
7390 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
7391 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7392 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7393 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7394 vv(1)=pizda(1,1)-pizda(2,2)
7395 vv(2)=pizda(1,2)+pizda(2,1)
7396 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7397 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
7398 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7399 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7400 vv(1)=pizda(1,1)-pizda(2,2)
7401 vv(2)=pizda(1,2)+pizda(2,1)
7403 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7404 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
7405 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7407 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7408 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
7409 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7411 ! Cartesian gradient
7415 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
7417 vv(1)=pizda(1,1)-pizda(2,2)
7418 vv(2)=pizda(1,2)+pizda(2,1)
7419 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7420 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
7421 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7427 ! Contribution from graph II
7428 call transpose2(EE(1,1,itk),auxmat(1,1))
7429 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7430 vv(1)=pizda(1,1)+pizda(2,2)
7431 vv(2)=pizda(2,1)-pizda(1,2)
7432 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
7433 -0.5d0*scalar2(vv(1),Ctobr(1,k))
7434 ! Explicit gradient in virtual-dihedral angles.
7435 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7436 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7437 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7438 vv(1)=pizda(1,1)+pizda(2,2)
7439 vv(2)=pizda(2,1)-pizda(1,2)
7441 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7442 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
7443 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7445 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7446 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
7447 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7449 ! Cartesian gradient
7453 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7455 vv(1)=pizda(1,1)+pizda(2,2)
7456 vv(2)=pizda(2,1)-pizda(1,2)
7457 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7458 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
7459 -0.5d0*scalar2(vv(1),Ctobr(1,k))
7467 ! Parallel orientation
7468 ! Contribution from graph III
7469 call transpose2(EUg(1,1,l),auxmat(1,1))
7470 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7471 vv(1)=pizda(1,1)-pizda(2,2)
7472 vv(2)=pizda(1,2)+pizda(2,1)
7473 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
7474 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7475 ! Explicit gradient in virtual-dihedral angles.
7476 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7477 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
7478 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7479 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7480 vv(1)=pizda(1,1)-pizda(2,2)
7481 vv(2)=pizda(1,2)+pizda(2,1)
7482 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7483 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
7484 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7485 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7486 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7487 vv(1)=pizda(1,1)-pizda(2,2)
7488 vv(2)=pizda(1,2)+pizda(2,1)
7489 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7490 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
7491 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7492 ! Cartesian gradient
7496 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
7498 vv(1)=pizda(1,1)-pizda(2,2)
7499 vv(2)=pizda(1,2)+pizda(2,1)
7500 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7501 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
7502 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7507 ! Contribution from graph IV
7509 call transpose2(EE(1,1,itl),auxmat(1,1))
7510 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7511 vv(1)=pizda(1,1)+pizda(2,2)
7512 vv(2)=pizda(2,1)-pizda(1,2)
7513 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
7514 -0.5d0*scalar2(vv(1),Ctobr(1,l))
7515 ! Explicit gradient in virtual-dihedral angles.
7516 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7517 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7518 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7519 vv(1)=pizda(1,1)+pizda(2,2)
7520 vv(2)=pizda(2,1)-pizda(1,2)
7521 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7522 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
7523 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7524 ! Cartesian gradient
7528 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7530 vv(1)=pizda(1,1)+pizda(2,2)
7531 vv(2)=pizda(2,1)-pizda(1,2)
7532 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7533 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
7534 -0.5d0*scalar2(vv(1),Ctobr(1,l))
7539 ! Antiparallel orientation
7540 ! Contribution from graph III
7542 call transpose2(EUg(1,1,j),auxmat(1,1))
7543 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7544 vv(1)=pizda(1,1)-pizda(2,2)
7545 vv(2)=pizda(1,2)+pizda(2,1)
7546 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
7547 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7548 ! Explicit gradient in virtual-dihedral angles.
7549 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7550 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
7551 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7552 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7553 vv(1)=pizda(1,1)-pizda(2,2)
7554 vv(2)=pizda(1,2)+pizda(2,1)
7555 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7556 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
7557 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7558 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7559 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7560 vv(1)=pizda(1,1)-pizda(2,2)
7561 vv(2)=pizda(1,2)+pizda(2,1)
7562 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7563 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
7564 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7565 ! Cartesian gradient
7569 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
7571 vv(1)=pizda(1,1)-pizda(2,2)
7572 vv(2)=pizda(1,2)+pizda(2,1)
7573 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
7574 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
7575 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7580 ! Contribution from graph IV
7582 call transpose2(EE(1,1,itj),auxmat(1,1))
7583 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7584 vv(1)=pizda(1,1)+pizda(2,2)
7585 vv(2)=pizda(2,1)-pizda(1,2)
7586 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
7587 -0.5d0*scalar2(vv(1),Ctobr(1,j))
7588 ! Explicit gradient in virtual-dihedral angles.
7589 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7590 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7591 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7592 vv(1)=pizda(1,1)+pizda(2,2)
7593 vv(2)=pizda(2,1)-pizda(1,2)
7594 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7595 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
7596 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7597 ! Cartesian gradient
7601 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7603 vv(1)=pizda(1,1)+pizda(2,2)
7604 vv(2)=pizda(2,1)-pizda(1,2)
7605 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
7606 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
7607 -0.5d0*scalar2(vv(1),Ctobr(1,j))
7613 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7614 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7615 !d write (2,*) 'ijkl',i,j,k,l
7616 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7617 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
7619 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7620 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7621 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7622 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7623 if (j.lt.nres-1) then
7630 if (l.lt.nres-1) then
7640 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7641 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
7642 ! summed up outside the subrouine as for the other subroutines
7643 ! handling long-range interactions. The old code is commented out
7644 ! with "cgrad" to keep track of changes.
7646 !grad ggg1(ll)=eel5*g_contij(ll,1)
7647 !grad ggg2(ll)=eel5*g_contij(ll,2)
7648 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7649 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7650 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7651 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7652 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7653 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7654 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7655 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7657 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7658 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7659 !grad ghalf=0.5d0*ggg1(ll)
7661 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7662 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7663 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7664 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7665 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7666 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7667 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7668 !grad ghalf=0.5d0*ggg2(ll)
7670 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7671 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7672 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7673 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7674 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7675 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7680 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7681 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7686 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7687 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7693 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7698 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7702 !d write (2,*) iii,g_corr5_loc(iii)
7705 !d write (2,*) 'ekont',ekont
7706 !d write (iout,*) 'eello5',ekont*eel5
7709 !-----------------------------------------------------------------------------
7710 real(kind=8) function eello6(i,j,k,l,jj,kk)
7711 ! implicit real*8 (a-h,o-z)
7712 ! include 'DIMENSIONS'
7713 ! include 'COMMON.IOUNITS'
7714 ! include 'COMMON.CHAIN'
7715 ! include 'COMMON.DERIV'
7716 ! include 'COMMON.INTERACT'
7717 ! include 'COMMON.CONTACTS'
7718 ! include 'COMMON.TORSION'
7719 ! include 'COMMON.VAR'
7720 ! include 'COMMON.GEO'
7721 ! include 'COMMON.FFIELD'
7722 real(kind=8),dimension(3) :: ggg1,ggg2
7723 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
7725 real(kind=8) :: gradcorr6ij,gradcorr6kl
7726 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
7727 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7732 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7740 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7741 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7745 derx(lll,kkk,iii)=0.0d0
7749 !d eij=facont_hb(jj,i)
7750 !d ekl=facont_hb(kk,k)
7756 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7757 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7758 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7759 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7760 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7761 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7763 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7764 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7765 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7766 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7767 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7768 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7772 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7774 ! If turn contributions are considered, they will be handled separately.
7775 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7776 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7777 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7778 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7779 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7780 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7781 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7783 if (j.lt.nres-1) then
7790 if (l.lt.nres-1) then
7798 !grad ggg1(ll)=eel6*g_contij(ll,1)
7799 !grad ggg2(ll)=eel6*g_contij(ll,2)
7800 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7801 !grad ghalf=0.5d0*ggg1(ll)
7803 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7804 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7805 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7806 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7807 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7808 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7809 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7810 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7811 !grad ghalf=0.5d0*ggg2(ll)
7812 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7814 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7815 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7816 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7817 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7818 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7819 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7824 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7825 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7830 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7831 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7837 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7842 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7846 !d write (2,*) iii,g_corr6_loc(iii)
7849 !d write (2,*) 'ekont',ekont
7850 !d write (iout,*) 'eello6',ekont*eel6
7853 !-----------------------------------------------------------------------------
7854 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
7856 ! implicit real*8 (a-h,o-z)
7857 ! include 'DIMENSIONS'
7858 ! include 'COMMON.IOUNITS'
7859 ! include 'COMMON.CHAIN'
7860 ! include 'COMMON.DERIV'
7861 ! include 'COMMON.INTERACT'
7862 ! include 'COMMON.CONTACTS'
7863 ! include 'COMMON.TORSION'
7864 ! include 'COMMON.VAR'
7865 ! include 'COMMON.GEO'
7866 real(kind=8),dimension(2) :: vv,vv1
7867 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
7870 !el common /kutas/ lprn
7871 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
7872 real(kind=8) :: s1,s2,s3,s4,s5
7873 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7875 ! Parallel Antiparallel C
7881 ! \ j|/k\| / \ |/k\|l / C
7886 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7887 itk=itortyp(itype(k))
7888 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7889 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7890 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7891 call transpose2(EUgC(1,1,k),auxmat(1,1))
7892 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7893 vv1(1)=pizda1(1,1)-pizda1(2,2)
7894 vv1(2)=pizda1(1,2)+pizda1(2,1)
7895 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7896 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7897 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7898 s5=scalar2(vv(1),Dtobr2(1,i))
7899 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7900 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7901 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
7902 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
7903 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
7904 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
7905 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
7906 +scalar2(vv(1),Dtobr2der(1,i)))
7907 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7908 vv1(1)=pizda1(1,1)-pizda1(2,2)
7909 vv1(2)=pizda1(1,2)+pizda1(2,1)
7910 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7911 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7913 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
7914 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
7915 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
7916 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
7917 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7919 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
7920 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
7921 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
7922 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
7923 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7925 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7926 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7927 vv1(1)=pizda1(1,1)-pizda1(2,2)
7928 vv1(2)=pizda1(1,2)+pizda1(2,1)
7929 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
7930 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
7931 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
7932 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7941 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7942 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7943 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7944 call transpose2(EUgC(1,1,k),auxmat(1,1))
7945 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
7947 vv1(1)=pizda1(1,1)-pizda1(2,2)
7948 vv1(2)=pizda1(1,2)+pizda1(2,1)
7949 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7950 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
7951 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7952 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
7953 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7954 s5=scalar2(vv(1),Dtobr2(1,i))
7955 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7960 end function eello6_graph1
7961 !-----------------------------------------------------------------------------
7962 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
7964 ! implicit real*8 (a-h,o-z)
7965 ! include 'DIMENSIONS'
7966 ! include 'COMMON.IOUNITS'
7967 ! include 'COMMON.CHAIN'
7968 ! include 'COMMON.DERIV'
7969 ! include 'COMMON.INTERACT'
7970 ! include 'COMMON.CONTACTS'
7971 ! include 'COMMON.TORSION'
7972 ! include 'COMMON.VAR'
7973 ! include 'COMMON.GEO'
7975 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
7976 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
7978 !el common /kutas/ lprn
7979 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
7980 real(kind=8) :: s2,s3,s4
7981 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7983 ! Parallel Antiparallel C
7989 ! \ j|/k\| \ |/k\|l C
7994 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7995 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7996 ! AL 7/4/01 s1 would occur in the sixth-order moment,
7997 ! but not in a cluster cumulant
7999 s1=dip(1,jj,i)*dip(1,kk,k)
8001 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8002 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8003 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8004 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8005 call transpose2(EUg(1,1,k),auxmat(1,1))
8006 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8007 vv(1)=pizda(1,1)-pizda(2,2)
8008 vv(2)=pizda(1,2)+pizda(2,1)
8009 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8010 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8012 eello6_graph2=-(s1+s2+s3+s4)
8014 eello6_graph2=-(s2+s3+s4)
8017 ! Derivatives in gamma(i-1)
8020 s1=dipderg(1,jj,i)*dip(1,kk,k)
8022 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8023 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8024 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8025 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8027 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8029 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8031 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8033 ! Derivatives in gamma(k-1)
8035 s1=dip(1,jj,i)*dipderg(1,kk,k)
8037 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8038 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8039 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8040 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8041 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8042 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8043 vv(1)=pizda(1,1)-pizda(2,2)
8044 vv(2)=pizda(1,2)+pizda(2,1)
8045 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8047 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8049 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8051 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8052 ! Derivatives in gamma(j-1) or gamma(l-1)
8055 s1=dipderg(3,jj,i)*dip(1,kk,k)
8057 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8058 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8059 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8060 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8061 vv(1)=pizda(1,1)-pizda(2,2)
8062 vv(2)=pizda(1,2)+pizda(2,1)
8063 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8066 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8068 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8071 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8072 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8074 ! Derivatives in gamma(l-1) or gamma(j-1)
8077 s1=dip(1,jj,i)*dipderg(3,kk,k)
8079 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8080 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8081 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8082 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8083 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8084 vv(1)=pizda(1,1)-pizda(2,2)
8085 vv(2)=pizda(1,2)+pizda(2,1)
8086 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8089 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8091 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8094 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8095 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8097 ! Cartesian derivatives.
8099 write (2,*) 'In eello6_graph2'
8101 write (2,*) 'iii=',iii
8103 write (2,*) 'kkk=',kkk
8105 write (2,'(3(2f10.5),5x)') &
8106 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8116 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8118 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8121 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
8123 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8124 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
8126 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8127 call transpose2(EUg(1,1,k),auxmat(1,1))
8128 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8130 vv(1)=pizda(1,1)-pizda(2,2)
8131 vv(2)=pizda(1,2)+pizda(2,1)
8132 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8133 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8135 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8137 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8140 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8142 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8148 end function eello6_graph2
8149 !-----------------------------------------------------------------------------
8150 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
8151 ! implicit real*8 (a-h,o-z)
8152 ! include 'DIMENSIONS'
8153 ! include 'COMMON.IOUNITS'
8154 ! include 'COMMON.CHAIN'
8155 ! include 'COMMON.DERIV'
8156 ! include 'COMMON.INTERACT'
8157 ! include 'COMMON.CONTACTS'
8158 ! include 'COMMON.TORSION'
8159 ! include 'COMMON.VAR'
8160 ! include 'COMMON.GEO'
8161 real(kind=8),dimension(2) :: vv,auxvec
8162 real(kind=8),dimension(2,2) :: pizda,auxmat
8164 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
8165 real(kind=8) :: s1,s2,s3,s4
8166 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8168 ! Parallel Antiparallel C
8174 ! j|/k\| / |/k\|l / C
8179 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8181 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
8182 ! energy moment and not to the cluster cumulant.
8183 iti=itortyp(itype(i))
8184 if (j.lt.nres-1) then
8185 itj1=itortyp(itype(j+1))
8189 itk=itortyp(itype(k))
8190 itk1=itortyp(itype(k+1))
8191 if (l.lt.nres-1) then
8192 itl1=itortyp(itype(l+1))
8197 s1=dip(4,jj,i)*dip(4,kk,k)
8199 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8200 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8201 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8202 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8203 call transpose2(EE(1,1,itk),auxmat(1,1))
8204 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8205 vv(1)=pizda(1,1)+pizda(2,2)
8206 vv(2)=pizda(2,1)-pizda(1,2)
8207 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8208 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8209 !d & "sum",-(s2+s3+s4)
8211 eello6_graph3=-(s1+s2+s3+s4)
8213 eello6_graph3=-(s2+s3+s4)
8216 ! Derivatives in gamma(k-1)
8217 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8218 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8219 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8220 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8221 ! Derivatives in gamma(l-1)
8222 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8223 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8224 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8225 vv(1)=pizda(1,1)+pizda(2,2)
8226 vv(2)=pizda(2,1)-pizda(1,2)
8227 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8228 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8229 ! Cartesian derivatives.
8235 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8237 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8240 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8242 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8243 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8245 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8246 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
8248 vv(1)=pizda(1,1)+pizda(2,2)
8249 vv(2)=pizda(2,1)-pizda(1,2)
8250 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8252 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8254 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8257 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8259 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8261 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8266 end function eello6_graph3
8267 !-----------------------------------------------------------------------------
8268 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8269 ! implicit real*8 (a-h,o-z)
8270 ! include 'DIMENSIONS'
8271 ! include 'COMMON.IOUNITS'
8272 ! include 'COMMON.CHAIN'
8273 ! include 'COMMON.DERIV'
8274 ! include 'COMMON.INTERACT'
8275 ! include 'COMMON.CONTACTS'
8276 ! include 'COMMON.TORSION'
8277 ! include 'COMMON.VAR'
8278 ! include 'COMMON.GEO'
8279 ! include 'COMMON.FFIELD'
8280 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
8281 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8283 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
8285 real(kind=8) :: s1,s2,s3,s4
8286 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8288 ! Parallel Antiparallel C
8294 ! \ j|/k\| \ |/k\|l C
8299 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8301 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
8302 ! energy moment and not to the cluster cumulant.
8303 !d write (2,*) 'eello_graph4: wturn6',wturn6
8304 iti=itortyp(itype(i))
8305 itj=itortyp(itype(j))
8306 if (j.lt.nres-1) then
8307 itj1=itortyp(itype(j+1))
8311 itk=itortyp(itype(k))
8312 if (k.lt.nres-1) then
8313 itk1=itortyp(itype(k+1))
8317 itl=itortyp(itype(l))
8318 if (l.lt.nres-1) then
8319 itl1=itortyp(itype(l+1))
8323 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8324 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8325 !d & ' itl',itl,' itl1',itl1
8328 s1=dip(3,jj,i)*dip(3,kk,k)
8330 s1=dip(2,jj,j)*dip(2,kk,l)
8333 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8334 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8336 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8337 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8339 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8340 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8342 call transpose2(EUg(1,1,k),auxmat(1,1))
8343 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8344 vv(1)=pizda(1,1)-pizda(2,2)
8345 vv(2)=pizda(2,1)+pizda(1,2)
8346 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8347 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8349 eello6_graph4=-(s1+s2+s3+s4)
8351 eello6_graph4=-(s2+s3+s4)
8353 ! Derivatives in gamma(i-1)
8357 s1=dipderg(2,jj,i)*dip(3,kk,k)
8359 s1=dipderg(4,jj,j)*dip(2,kk,l)
8362 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8364 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8365 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8367 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8368 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8370 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8371 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8372 !d write (2,*) 'turn6 derivatives'
8374 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8376 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8380 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8382 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8386 ! Derivatives in gamma(k-1)
8389 s1=dip(3,jj,i)*dipderg(2,kk,k)
8391 s1=dip(2,jj,j)*dipderg(4,kk,l)
8394 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8395 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8397 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8398 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8400 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8401 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8403 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8404 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8405 vv(1)=pizda(1,1)-pizda(2,2)
8406 vv(2)=pizda(2,1)+pizda(1,2)
8407 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8408 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8410 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8412 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8416 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8418 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8421 ! Derivatives in gamma(j-1) or gamma(l-1)
8422 if (l.eq.j+1 .and. l.gt.1) then
8423 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8424 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8425 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8426 vv(1)=pizda(1,1)-pizda(2,2)
8427 vv(2)=pizda(2,1)+pizda(1,2)
8428 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8429 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8430 else if (j.gt.1) then
8431 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8432 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8433 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8434 vv(1)=pizda(1,1)-pizda(2,2)
8435 vv(2)=pizda(2,1)+pizda(1,2)
8436 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8437 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8438 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8440 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8443 ! Cartesian derivatives.
8450 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8452 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8456 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8458 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8462 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
8464 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8466 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
8467 b1(1,itj1),auxvec(1))
8468 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8470 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
8471 b1(1,itl1),auxvec(1))
8472 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8474 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
8476 vv(1)=pizda(1,1)-pizda(2,2)
8477 vv(2)=pizda(2,1)+pizda(1,2)
8478 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8480 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8482 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
8485 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
8488 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8491 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8493 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8495 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8499 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8501 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8504 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8506 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8513 end function eello6_graph4
8514 !-----------------------------------------------------------------------------
8515 real(kind=8) function eello_turn6(i,jj,kk)
8516 ! implicit real*8 (a-h,o-z)
8517 ! include 'DIMENSIONS'
8518 ! include 'COMMON.IOUNITS'
8519 ! include 'COMMON.CHAIN'
8520 ! include 'COMMON.DERIV'
8521 ! include 'COMMON.INTERACT'
8522 ! include 'COMMON.CONTACTS'
8523 ! include 'COMMON.TORSION'
8524 ! include 'COMMON.VAR'
8525 ! include 'COMMON.GEO'
8526 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
8527 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
8528 real(kind=8),dimension(3) :: ggg1,ggg2
8529 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
8530 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
8531 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8532 ! the respective energy moment and not to the cluster cumulant.
8534 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
8535 integer :: j1,j2,l1,l2,ll
8536 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
8537 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
8546 iti=itortyp(itype(i))
8547 itk=itortyp(itype(k))
8548 itk1=itortyp(itype(k+1))
8549 itl=itortyp(itype(l))
8550 itj=itortyp(itype(j))
8551 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8552 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
8553 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8558 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8560 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
8564 derx_turn(lll,kkk,iii)=0.0d0
8571 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8573 !d write (2,*) 'eello6_5',eello6_5
8575 call transpose2(AEA(1,1,1),auxmat(1,1))
8576 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8577 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8578 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8580 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8581 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8582 s2 = scalar2(b1(1,itk),vtemp1(1))
8584 call transpose2(AEA(1,1,2),atemp(1,1))
8585 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8586 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8587 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8589 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8590 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8591 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8593 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8594 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8595 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8596 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8597 ss13 = scalar2(b1(1,itk),vtemp4(1))
8598 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8600 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8606 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8607 ! Derivatives in gamma(i+2)
8611 call transpose2(AEA(1,1,1),auxmatd(1,1))
8612 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8613 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8614 call transpose2(AEAderg(1,1,2),atempd(1,1))
8615 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8616 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8618 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8619 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8620 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8626 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8627 ! Derivatives in gamma(i+3)
8629 call transpose2(AEA(1,1,1),auxmatd(1,1))
8630 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8631 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8632 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8634 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8635 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8636 s2d = scalar2(b1(1,itk),vtemp1d(1))
8638 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8639 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8641 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8643 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8644 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8645 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8653 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
8654 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8656 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
8657 -0.5d0*ekont*(s2d+s12d)
8659 ! Derivatives in gamma(i+4)
8660 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8661 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8662 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8664 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8665 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8666 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8674 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8676 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8678 ! Derivatives in gamma(i+5)
8680 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8681 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8682 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8684 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8685 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8686 s2d = scalar2(b1(1,itk),vtemp1d(1))
8688 call transpose2(AEA(1,1,2),atempd(1,1))
8689 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8690 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8692 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8693 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8695 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8696 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8697 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8705 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
8706 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8708 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
8709 -0.5d0*ekont*(s2d+s12d)
8711 ! Cartesian derivatives
8716 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8717 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8718 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8720 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8721 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
8723 s2d = scalar2(b1(1,itk),vtemp1d(1))
8725 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8726 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8727 s8d = -(atempd(1,1)+atempd(2,2))* &
8728 scalar2(cc(1,1,itl),vtemp2(1))
8730 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
8732 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8733 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8740 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
8743 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
8747 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
8750 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
8759 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
8761 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8762 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8763 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8764 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8765 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
8767 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8768 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8769 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8773 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8774 !d & 16*eel_turn6_num
8776 if (j.lt.nres-1) then
8783 if (l.lt.nres-1) then
8791 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
8792 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
8793 !grad ghalf=0.5d0*ggg1(ll)
8795 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8796 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8797 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
8798 +ekont*derx_turn(ll,2,1)
8799 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8800 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
8801 +ekont*derx_turn(ll,4,1)
8802 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8803 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8804 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8805 !grad ghalf=0.5d0*ggg2(ll)
8807 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
8808 +ekont*derx_turn(ll,2,2)
8809 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8810 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
8811 +ekont*derx_turn(ll,4,2)
8812 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8813 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8814 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8819 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8824 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8830 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8835 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8839 !d write (2,*) iii,g_corr6_loc(iii)
8841 eello_turn6=ekont*eel_turn6
8842 !d write (2,*) 'ekont',ekont
8843 !d write (2,*) 'eel_turn6',ekont*eel_turn6
8845 end function eello_turn6
8846 !-----------------------------------------------------------------------------
8847 subroutine MATVEC2(A1,V1,V2)
8848 !DIR$ INLINEALWAYS MATVEC2
8850 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8852 ! implicit real*8 (a-h,o-z)
8853 ! include 'DIMENSIONS'
8854 real(kind=8),dimension(2) :: V1,V2
8855 real(kind=8),dimension(2,2) :: A1
8856 real(kind=8) :: vaux1,vaux2
8860 ! 3 VI=VI+A1(I,K)*V1(K)
8864 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8865 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8869 end subroutine MATVEC2
8870 !-----------------------------------------------------------------------------
8871 subroutine MATMAT2(A1,A2,A3)
8873 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8875 ! implicit real*8 (a-h,o-z)
8876 ! include 'DIMENSIONS'
8877 real(kind=8),dimension(2,2) :: A1,A2,A3
8878 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
8879 ! DIMENSION AI3(2,2)
8883 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
8889 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8890 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8891 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8892 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8898 end subroutine MATMAT2
8899 !-----------------------------------------------------------------------------
8900 real(kind=8) function scalar2(u,v)
8901 !DIR$ INLINEALWAYS scalar2
8903 real(kind=8),dimension(2) :: u,v
8906 scalar2=u(1)*v(1)+u(2)*v(2)
8908 end function scalar2
8909 !-----------------------------------------------------------------------------
8910 subroutine transpose2(a,at)
8911 !DIR$ INLINEALWAYS transpose2
8913 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
8916 real(kind=8),dimension(2,2) :: a,at
8922 end subroutine transpose2
8923 !-----------------------------------------------------------------------------
8924 subroutine transpose(n,a,at)
8927 real(kind=8),dimension(n,n) :: a,at
8934 end subroutine transpose
8935 !-----------------------------------------------------------------------------
8936 subroutine prodmat3(a1,a2,kk,transp,prod)
8937 !DIR$ INLINEALWAYS prodmat3
8939 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
8943 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
8945 !rc double precision auxmat(2,2),prod_(2,2)
8948 !rc call transpose2(kk(1,1),auxmat(1,1))
8949 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8950 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8952 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
8953 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8954 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
8955 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8956 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
8957 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8958 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
8959 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8962 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8963 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8965 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
8966 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8967 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
8968 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8969 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
8970 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8971 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
8972 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8975 ! call transpose2(a2(1,1),a2t(1,1))
8978 !rc print *,((prod_(i,j),i=1,2),j=1,2)
8979 !rc print *,((prod(i,j),i=1,2),j=1,2)
8982 end subroutine prodmat3
8983 !-----------------------------------------------------------------------------
8984 ! energy_p_new_barrier.F
8985 !-----------------------------------------------------------------------------
8986 subroutine sum_gradient
8987 ! implicit real*8 (a-h,o-z)
8988 use io_base, only: pdbout
8989 ! include 'DIMENSIONS'
8993 !MS$ATTRIBUTES C :: proc_proc
8999 real(kind=8),dimension(3,nres) :: gradbufc,gradbufx,gradbufc_sum,&
9000 gloc_scbuf !(3,maxres)
9002 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
9005 integer :: i,j,k,ierror,ierr
9006 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
9007 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
9008 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
9009 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
9010 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
9011 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
9012 gsccorr_max,gsccorrx_max,time00
9014 ! include 'COMMON.SETUP'
9015 ! include 'COMMON.IOUNITS'
9016 ! include 'COMMON.FFIELD'
9017 ! include 'COMMON.DERIV'
9018 ! include 'COMMON.INTERACT'
9019 ! include 'COMMON.SBRIDGE'
9020 ! include 'COMMON.CHAIN'
9021 ! include 'COMMON.VAR'
9022 ! include 'COMMON.CONTROL'
9023 ! include 'COMMON.TIME1'
9024 ! include 'COMMON.MAXGRAD'
9025 ! include 'COMMON.SCCOR'
9030 write (iout,*) "sum_gradient gvdwc, gvdwx"
9032 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9033 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
9043 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
9044 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
9045 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
9048 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
9049 ! in virtual-bond-vector coordinates
9052 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
9054 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
9055 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
9057 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
9059 ! write (iout,'(i5,3f10.5,2x,f10.5)')
9060 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
9062 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
9064 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9065 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
9066 (gvdwc_scpp(j,i),j=1,3)
9068 write (iout,*) "gelc_long gvdwpp gel_loc_long"
9070 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9071 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
9072 (gelc_loc_long(j,i),j=1,3)
9079 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
9080 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
9081 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
9082 wel_loc*gel_loc_long(j,i)+ &
9083 wcorr*gradcorr_long(j,i)+ &
9084 wcorr5*gradcorr5_long(j,i)+ &
9085 wcorr6*gradcorr6_long(j,i)+ &
9086 wturn6*gcorr6_turn_long(j,i)+ &
9093 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
9094 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
9095 welec*gelc_long(j,i)+ &
9097 wel_loc*gel_loc_long(j,i)+ &
9098 wcorr*gradcorr_long(j,i)+ &
9099 wcorr5*gradcorr5_long(j,i)+ &
9100 wcorr6*gradcorr6_long(j,i)+ &
9101 wturn6*gcorr6_turn_long(j,i)+ &
9107 if (nfgtasks.gt.1) then
9110 write (iout,*) "gradbufc before allreduce"
9112 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9118 gradbufc_sum(j,i)=gradbufc(j,i)
9121 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
9122 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
9123 ! time_reduce=time_reduce+MPI_Wtime()-time00
9125 ! write (iout,*) "gradbufc_sum after allreduce"
9127 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
9132 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
9140 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
9141 write (iout,*) (i," jgrad_start",jgrad_start(i),&
9142 " jgrad_end ",jgrad_end(i),&
9143 i=igrad_start,igrad_end)
9146 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
9147 ! do not parallelize this part.
9149 ! do i=igrad_start,igrad_end
9150 ! do j=jgrad_start(i),jgrad_end(i)
9152 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
9157 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
9161 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
9165 write (iout,*) "gradbufc after summing"
9167 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9175 write (iout,*) "gradbufc"
9177 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9184 gradbufc_sum(j,i)=gradbufc(j,i)
9189 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
9193 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
9198 ! gradbufc(k,i)=0.0d0
9202 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
9208 write (iout,*) "gradbufc after summing"
9210 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9219 gradbufc(k,nres)=0.0d0
9222 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
9223 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
9224 !el-----------------
9228 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
9229 wel_loc*gel_loc(j,i)+ &
9230 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
9231 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
9232 wel_loc*gel_loc_long(j,i)+ &
9233 wcorr*gradcorr_long(j,i)+ &
9234 wcorr5*gradcorr5_long(j,i)+ &
9235 wcorr6*gradcorr6_long(j,i)+ &
9236 wturn6*gcorr6_turn_long(j,i))+ &
9238 wcorr*gradcorr(j,i)+ &
9239 wturn3*gcorr3_turn(j,i)+ &
9240 wturn4*gcorr4_turn(j,i)+ &
9241 wcorr5*gradcorr5(j,i)+ &
9242 wcorr6*gradcorr6(j,i)+ &
9243 wturn6*gcorr6_turn(j,i)+ &
9244 wsccor*gsccorc(j,i) &
9247 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
9248 wel_loc*gel_loc(j,i)+ &
9249 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
9250 welec*gelc_long(j,i)+ &
9251 wel_loc*gel_loc_long(j,i)+ &
9252 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
9253 wcorr5*gradcorr5_long(j,i)+ &
9254 wcorr6*gradcorr6_long(j,i)+ &
9255 wturn6*gcorr6_turn_long(j,i))+ &
9257 wcorr*gradcorr(j,i)+ &
9258 wturn3*gcorr3_turn(j,i)+ &
9259 wturn4*gcorr4_turn(j,i)+ &
9260 wcorr5*gradcorr5(j,i)+ &
9261 wcorr6*gradcorr6(j,i)+ &
9262 wturn6*gcorr6_turn(j,i)+ &
9263 wsccor*gsccorc(j,i) &
9266 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
9267 wbond*gradbx(j,i)+ &
9268 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
9269 wsccor*gsccorx(j,i) &
9270 +wscloc*gsclocx(j,i)
9274 write (iout,*) "gloc before adding corr"
9276 write (iout,*) i,gloc(i,icg)
9280 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
9281 +wcorr5*g_corr5_loc(i) &
9282 +wcorr6*g_corr6_loc(i) &
9283 +wturn4*gel_loc_turn4(i) &
9284 +wturn3*gel_loc_turn3(i) &
9285 +wturn6*gel_loc_turn6(i) &
9286 +wel_loc*gel_loc_loc(i)
9289 write (iout,*) "gloc after adding corr"
9291 write (iout,*) i,gloc(i,icg)
9295 if (nfgtasks.gt.1) then
9298 gradbufc(j,i)=gradc(j,i,icg)
9299 gradbufx(j,i)=gradx(j,i,icg)
9303 glocbuf(i)=gloc(i,icg)
9307 write (iout,*) "gloc_sc before reduce"
9310 write (iout,*) i,j,gloc_sc(j,i,icg)
9317 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
9321 call MPI_Barrier(FG_COMM,IERR)
9322 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
9324 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,&
9325 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9326 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,&
9327 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9328 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
9329 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9330 time_reduce=time_reduce+MPI_Wtime()-time00
9331 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
9332 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9333 time_reduce=time_reduce+MPI_Wtime()-time00
9336 write (iout,*) "gloc_sc after reduce"
9339 write (iout,*) i,j,gloc_sc(j,i,icg)
9345 write (iout,*) "gloc after reduce"
9347 write (iout,*) i,gloc(i,icg)
9352 if (gnorm_check) then
9354 ! Compute the maximum elements of the gradient
9364 gcorr3_turn_max=0.0d0
9365 gcorr4_turn_max=0.0d0
9368 gcorr6_turn_max=0.0d0
9378 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
9379 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
9380 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
9381 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
9382 gvdwc_scp_max=gvdwc_scp_norm
9383 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
9384 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
9385 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
9386 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
9387 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
9388 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
9389 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
9390 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
9391 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
9392 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
9393 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
9394 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
9395 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
9397 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
9398 gcorr3_turn_max=gcorr3_turn_norm
9399 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
9401 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
9402 gcorr4_turn_max=gcorr4_turn_norm
9403 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
9404 if (gradcorr5_norm.gt.gradcorr5_max) &
9405 gradcorr5_max=gradcorr5_norm
9406 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
9407 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
9408 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
9410 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
9411 gcorr6_turn_max=gcorr6_turn_norm
9412 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
9413 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
9414 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
9415 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
9416 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
9417 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
9418 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
9419 if (gradx_scp_norm.gt.gradx_scp_max) &
9420 gradx_scp_max=gradx_scp_norm
9421 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
9422 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
9423 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
9424 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
9425 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
9426 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
9427 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
9428 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
9432 open(istat,file=statname,position="append")
9434 open(istat,file=statname,access="append")
9436 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
9437 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
9438 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
9439 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
9440 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
9441 gsccorx_max,gsclocx_max
9443 if (gvdwc_max.gt.1.0d4) then
9444 write (iout,*) "gvdwc gvdwx gradb gradbx"
9446 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
9447 gradb(j,i),gradbx(j,i),j=1,3)
9449 call pdbout(0.0d0,'cipiszcze',iout)
9456 write (iout,*) "gradc gradx gloc"
9458 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
9459 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
9464 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
9467 end subroutine sum_gradient
9468 !-----------------------------------------------------------------------------
9470 ! implicit real*8 (a-h,o-z)
9472 ! include 'DIMENSIONS'
9473 ! include 'COMMON.CHAIN'
9474 ! include 'COMMON.DERIV'
9475 ! include 'COMMON.CALC'
9476 ! include 'COMMON.IOUNITS'
9477 real(kind=8), dimension(3) :: dcosom1,dcosom2
9479 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
9480 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
9481 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
9482 -2.0D0*alf12*eps3der+sigder*sigsq_om12
9486 ! eom12=evdwij*eps1_om12
9488 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
9490 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
9491 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
9493 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
9494 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
9497 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
9499 ! write (iout,*) "gg",(gg(k),k=1,3)
9501 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
9502 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
9503 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
9504 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
9505 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
9506 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
9507 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
9508 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
9509 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
9510 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
9513 ! Calculate the components of the gradient in DC and X
9517 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
9521 gvdwc(l,i)=gvdwc(l,i)-gg(l)
9522 gvdwc(l,j)=gvdwc(l,j)+gg(l)
9525 end subroutine sc_grad
9527 !-----------------------------------------------------------------------------
9528 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
9531 ! implicit real*8 (a-h,o-z)
9532 ! include 'DIMENSIONS'
9533 ! include 'COMMON.LOCAL'
9534 ! include 'COMMON.IOUNITS'
9535 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
9536 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
9537 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
9538 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
9539 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
9541 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
9542 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
9543 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
9546 delthec=thetai-thet_pred_mean
9547 delthe0=thetai-theta0i
9548 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
9549 t3 = thetai-thet_pred_mean
9553 t14 = t12+t6*sigsqtc
9555 t21 = thetai-theta0i
9561 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
9562 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
9563 *(-t12*t9-ak*sig0inv*t27)
9565 end subroutine mixder
9567 !-----------------------------------------------------------------------------
9569 !-----------------------------------------------------------------------------
9571 !-----------------------------------------------------------------------------
9572 ! This subroutine calculates the derivatives of the consecutive virtual
9573 ! bond vectors and the SC vectors in the virtual-bond angles theta and
9574 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
9575 ! in the angles alpha and omega, describing the location of a side chain
9576 ! in its local coordinate system.
9578 ! The derivatives are stored in the following arrays:
9580 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
9581 ! The structure is as follows:
9583 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
9584 ! dDC(x,3)/dT(4),...,dDC(z,3)/dT(4),dDC(x,3)/dP(4),dDC(y,4)/dP(4),dDC(z,4)/dP(4)
9585 ! . . . . . . . . . . . . . . . . . .
9586 ! dDC(x,N-1)/dT(4),...,dDC(z,N-1)/dT(4),dDC(x,N-1)/dP(4),dDC(y,N-1)/dP(4),dDC(z,N-1)/dP(4)
9590 ! dDC(x,N-1)/dT(N),...,dDC(z,N-1)/dT(N),dDC(x,N-1)/dP(N),dDC(y,N-1)/dP(N),dDC(z,N-1)/dP(N)
9592 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
9593 ! The structure is same as above.
9595 ! DCDS - the derivatives of the side chain vectors in the local spherical
9596 ! andgles alph and omega:
9598 ! dX(x,2)/dA(2),dX(y,2)/dA(2),dX(z,2)/dA(2),dX(x,2)/dO(2),dX(y,2)/dO(2),dX(z,2)/dO(2)
9599 ! dX(x,3)/dA(3),dX(y,3)/dA(3),dX(z,3)/dA(3),dX(x,3)/dO(3),dX(y,3)/dO(3),dX(z,3)/dO(3)
9603 ! dX(x,N-1)/dA(N-1),dX(y,N-1)/dA(N-1),dX(z,N-1)/dA(N-1),dX(x,N-1)/dO(N-1),dX(y,N-1)/dO(N-1),dX(z,N-1)/dO(N-1)
9605 ! Version of March '95, based on an early version of November '91.
9607 !**********************************************************************
9608 ! implicit real*8 (a-h,o-z)
9609 ! include 'DIMENSIONS'
9610 ! include 'COMMON.VAR'
9611 ! include 'COMMON.CHAIN'
9612 ! include 'COMMON.DERIV'
9613 ! include 'COMMON.GEO'
9614 ! include 'COMMON.LOCAL'
9615 ! include 'COMMON.INTERACT'
9616 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
9617 real(kind=8),dimension(3,3) :: dp,temp
9618 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
9619 real(kind=8),dimension(3) :: xx,xx1
9621 integer :: i,k,l,j,m,ind,ind1,jjj
9622 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
9623 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
9624 sint2,xp,yp,xxp,yyp,zzp,dj
9626 ! common /przechowalnia/ fromto
9627 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
9628 ! get the position of the jth ijth fragment of the chain coordinate system
9629 ! in the fromto array.
9630 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
9632 ! maxdim=(nres-1)*(nres-2)/2
9633 ! allocate(dcdv(6,maxdim),dxds(6,nres))
9634 ! calculate the derivatives of transformation matrix elements in theta
9637 !el call flush(iout) !el
9639 rdt(1,1,i)=-rt(1,2,i)
9640 rdt(1,2,i)= rt(1,1,i)
9642 rdt(2,1,i)=-rt(2,2,i)
9643 rdt(2,2,i)= rt(2,1,i)
9645 rdt(3,1,i)=-rt(3,2,i)
9646 rdt(3,2,i)= rt(3,1,i)
9650 ! derivatives in phi
9656 drt(2,1,i)= rt(3,1,i)
9657 drt(2,2,i)= rt(3,2,i)
9658 drt(2,3,i)= rt(3,3,i)
9659 drt(3,1,i)=-rt(2,1,i)
9660 drt(3,2,i)=-rt(2,2,i)
9661 drt(3,3,i)=-rt(2,3,i)
9664 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
9675 fromto(k,l,ind)=temp(k,l)
9684 dpkl=dpkl+temp(k,m)*rt(m,l,j)
9687 fromto(k,l,ind)=dpkl
9698 ! Calculate derivatives.
9704 ! Derivatives of DC(i+1) in theta(i+2)
9710 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
9713 prordt(j,k,i)=dp(j,k)
9716 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
9719 ! Derivatives of SC(i+1) in theta(i+2)
9721 xx1(1)=-0.5D0*xloc(2,i+1)
9722 xx1(2)= 0.5D0*xloc(1,i+1)
9726 xj=xj+r(j,k,i)*xx1(k)
9733 rj=rj+prod(j,k,i)*xx(k)
9738 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
9739 ! than the other off-diagonal derivatives.
9744 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
9746 dxdv(j,ind1+1)=dxoiij
9748 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
9750 ! Derivatives of DC(i+1) in phi(i+2)
9756 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
9759 prodrt(j,k,i)=dp(j,k)
9761 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
9764 ! Derivatives of SC(i+1) in phi(i+2)
9767 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
9768 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
9772 rj=rj+prod(j,k,i)*xx(k)
9777 ! Derivatives of SC(i+1) in phi(i+3).
9782 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
9784 dxdv(j+3,ind1+1)=dxoiij
9787 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
9788 ! theta(nres) and phi(i+3) thru phi(nres).
9793 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
9798 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
9803 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
9804 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
9805 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
9806 ! Derivatives of virtual-bond vectors in theta
9808 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
9810 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
9811 ! Derivatives of SC vectors in theta
9815 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
9817 dxdv(k,ind1+1)=dxoijk
9820 !--- Calculate the derivatives in phi
9826 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
9832 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
9837 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
9839 dxdv(k+3,ind1+1)=dxoijk
9844 ! Derivatives in alpha and omega:
9847 ! dsci=dsc(itype(i))
9852 if(alphi.ne.alphi) alphi=100.0
9853 if(omegi.ne.omegi) omegi=-100.0
9858 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
9859 cosalphi=dcos(alphi)
9860 sinalphi=dsin(alphi)
9861 cosomegi=dcos(omegi)
9862 sinomegi=dsin(omegi)
9863 temp(1,1)=-dsci*sinalphi
9864 temp(2,1)= dsci*cosalphi*cosomegi
9865 temp(3,1)=-dsci*cosalphi*sinomegi
9867 temp(2,2)=-dsci*sinalphi*sinomegi
9868 temp(3,2)=-dsci*sinalphi*cosomegi
9869 theta2=pi-0.5D0*theta(i+1)
9873 !d print *,((temp(l,k),l=1,3),k=1,2)
9877 xxp= xp*cost2+yp*sint2
9878 yyp=-xp*sint2+yp*cost2
9881 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
9882 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
9886 dj=dj+prod(k,l,i-1)*xx(l)
9894 end subroutine cartder
9895 !-----------------------------------------------------------------------------
9897 !-----------------------------------------------------------------------------
9898 subroutine check_cartgrad
9899 ! Check the gradient of Cartesian coordinates in internal coordinates.
9900 ! implicit real*8 (a-h,o-z)
9901 ! include 'DIMENSIONS'
9902 ! include 'COMMON.IOUNITS'
9903 ! include 'COMMON.VAR'
9904 ! include 'COMMON.CHAIN'
9905 ! include 'COMMON.GEO'
9906 ! include 'COMMON.LOCAL'
9907 ! include 'COMMON.DERIV'
9908 real(kind=8),dimension(6,nres) :: temp
9909 real(kind=8),dimension(3) :: xx,gg
9911 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
9912 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
9914 ! Check the gradient of the virtual-bond and SC vectors in the internal
9920 write (iout,'(a)') '**************** dx/dalpha'
9924 alph(i)=alph(i)+aincr
9926 temp(k,i)=dc(k,nres+i)
9930 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
9931 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
9933 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
9934 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
9940 write (iout,'(a)') '**************** dx/domega'
9944 omeg(i)=omeg(i)+aincr
9946 temp(k,i)=dc(k,nres+i)
9950 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
9951 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
9952 (aincr*dabs(dxds(k+3,i))+aincr))
9954 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
9955 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
9961 write (iout,'(a)') '**************** dx/dtheta'
9965 theta(i)=theta(i)+aincr
9968 temp(k,j)=dc(k,nres+j)
9974 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
9976 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
9977 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
9978 (aincr*dabs(dxdv(k,ii))+aincr))
9980 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
9981 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
9988 write (iout,'(a)') '***************** dx/dphi'
9994 temp(k,j)=dc(k,nres+j)
10002 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
10003 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
10004 (aincr*dabs(dxdv(k+3,ii))+aincr))
10006 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10007 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
10010 phi(i)=phi(i)-aincr
10013 write (iout,'(a)') '****************** ddc/dtheta'
10016 theta(i+2)=thet+aincr
10027 gg(k)=(dc(k,j)-temp(k,j))/aincr
10028 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
10029 (aincr*dabs(dcdv(k,ii))+aincr))
10031 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10032 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
10042 write (iout,'(a)') '******************* ddc/dphi'
10045 phi(i+3)=phii+aincr
10056 gg(k)=(dc(k,j)-temp(k,j))/aincr
10057 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
10058 (aincr*dabs(dcdv(k+3,ii))+aincr))
10060 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10061 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
10072 end subroutine check_cartgrad
10073 !-----------------------------------------------------------------------------
10074 subroutine check_ecart
10075 ! Check the gradient of the energy in Cartesian coordinates.
10076 ! implicit real*8 (a-h,o-z)
10077 ! include 'DIMENSIONS'
10078 ! include 'COMMON.CHAIN'
10079 ! include 'COMMON.DERIV'
10080 ! include 'COMMON.IOUNITS'
10081 ! include 'COMMON.VAR'
10082 ! include 'COMMON.CONTACTS'
10084 !el integer :: icall
10085 !el common /srutu/ icall
10086 real(kind=8),dimension(6) :: ggg
10087 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
10088 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10089 real(kind=8),dimension(6,nres) :: grad_s
10090 real(kind=8),dimension(0:n_ene) :: energia,energia1
10091 integer :: uiparm(1)
10092 real(kind=8) :: urparm(1)
10094 integer :: nf,i,j,k
10095 real(kind=8) :: aincr,etot,etot1
10101 print '(a)','CG processor',me,' calling CHECK_CART.'
10104 call geom_to_var(nvar,x)
10105 call etotal(energia)
10107 !el call enerprint(energia)
10108 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
10111 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10115 grad_s(j,i)=gradc(j,i,icg)
10116 grad_s(j+3,i)=gradx(j,i,icg)
10120 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10125 ddx(j)=dc(j,i+nres)
10128 dc(j,i)=dc(j,i)+aincr
10130 c(j,k)=c(j,k)+aincr
10131 c(j,k+nres)=c(j,k+nres)+aincr
10133 call etotal(energia1)
10135 ggg(j)=(etot1-etot)/aincr
10138 c(j,k)=c(j,k)-aincr
10139 c(j,k+nres)=c(j,k+nres)-aincr
10143 c(j,i+nres)=c(j,i+nres)+aincr
10144 dc(j,i+nres)=dc(j,i+nres)+aincr
10145 call etotal(energia1)
10147 ggg(j+3)=(etot1-etot)/aincr
10149 dc(j,i+nres)=ddx(j)
10151 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
10152 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
10155 end subroutine check_ecart
10156 !-----------------------------------------------------------------------------
10157 subroutine check_ecartint
10158 ! Check the gradient of the energy in Cartesian coordinates.
10159 use io_base, only: intout
10160 ! implicit real*8 (a-h,o-z)
10161 ! include 'DIMENSIONS'
10162 ! include 'COMMON.CONTROL'
10163 ! include 'COMMON.CHAIN'
10164 ! include 'COMMON.DERIV'
10165 ! include 'COMMON.IOUNITS'
10166 ! include 'COMMON.VAR'
10167 ! include 'COMMON.CONTACTS'
10168 ! include 'COMMON.MD'
10169 ! include 'COMMON.LOCAL'
10170 ! include 'COMMON.SPLITELE'
10172 !el integer :: icall
10173 !el common /srutu/ icall
10174 real(kind=8),dimension(6) :: ggg,ggg1
10175 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
10176 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10177 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
10178 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
10179 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
10180 real(kind=8),dimension(0:n_ene) :: energia,energia1
10181 integer :: uiparm(1)
10182 real(kind=8) :: urparm(1)
10184 integer :: i,j,k,nf
10185 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
10193 ! call intcartderiv
10194 ! call checkintcartgrad
10197 write(iout,*) 'Calling CHECK_ECARTINT.'
10200 call geom_to_var(nvar,x)
10201 if (.not.split_ene) then
10202 write(iout,*) 'Calling CHECK_ECARTINT if'
10203 call etotal(energia)
10204 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
10206 !el call enerprint(energia)
10207 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
10209 write (iout,*) "enter cartgrad"
10212 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
10213 write (iout,*) "exit cartgrad"
10217 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10220 grad_s(j,0)=gcart(j,0)
10222 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
10225 grad_s(j,i)=gcart(j,i)
10226 grad_s(j+3,i)=gxcart(j,i)
10230 write(iout,*) 'Calling CHECK_ECARTIN else.'
10231 !- split gradient check
10233 call etotal_long(energia)
10234 !el call enerprint(energia)
10236 write (iout,*) "enter cartgrad"
10239 write (iout,*) "exit cartgrad"
10242 write (iout,*) "longrange grad"
10244 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10245 (gxcart(j,i),j=1,3)
10248 grad_s(j,0)=gcart(j,0)
10252 grad_s(j,i)=gcart(j,i)
10253 grad_s(j+3,i)=gxcart(j,i)
10257 call etotal_short(energia)
10258 !el call enerprint(energia)
10260 write (iout,*) "enter cartgrad"
10263 write (iout,*) "exit cartgrad"
10266 write (iout,*) "shortrange grad"
10268 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10269 (gxcart(j,i),j=1,3)
10272 grad_s1(j,0)=gcart(j,0)
10276 grad_s1(j,i)=gcart(j,i)
10277 grad_s1(j+3,i)=gxcart(j,i)
10281 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10286 ddx(j)=dc(j,i+nres)
10288 dcnorm_safe(k)=dc_norm(k,i)
10289 dxnorm_safe(k)=dc_norm(k,i+nres)
10293 dc(j,i)=ddc(j)+aincr
10294 call chainbuild_cart
10296 ! Broadcast the order to compute internal coordinates to the slaves.
10297 ! if (nfgtasks.gt.1)
10298 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
10300 ! call int_from_cart1(.false.)
10301 if (.not.split_ene) then
10302 call etotal(energia1)
10306 call etotal_long(energia1)
10308 call etotal_short(energia1)
10310 ! write (iout,*) "etot11",etot11," etot12",etot12
10312 !- end split gradient
10313 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10314 dc(j,i)=ddc(j)-aincr
10315 call chainbuild_cart
10316 ! call int_from_cart1(.false.)
10317 if (.not.split_ene) then
10318 call etotal(energia1)
10320 ggg(j)=(etot1-etot2)/(2*aincr)
10323 call etotal_long(energia1)
10325 ggg(j)=(etot11-etot21)/(2*aincr)
10326 call etotal_short(energia1)
10328 ggg1(j)=(etot12-etot22)/(2*aincr)
10329 !- end split gradient
10330 ! write (iout,*) "etot21",etot21," etot22",etot22
10332 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10334 call chainbuild_cart
10337 dc(j,i+nres)=ddx(j)+aincr
10338 call chainbuild_cart
10339 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
10340 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
10341 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
10342 ! write (iout,*) "dxnormnorm",dsqrt(
10343 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
10344 ! write (iout,*) "dxnormnormsafe",dsqrt(
10345 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
10347 if (.not.split_ene) then
10348 call etotal(energia1)
10352 call etotal_long(energia1)
10354 call etotal_short(energia1)
10357 !- end split gradient
10358 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10359 dc(j,i+nres)=ddx(j)-aincr
10360 call chainbuild_cart
10361 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
10362 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
10363 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
10365 ! write (iout,*) "dxnormnorm",dsqrt(
10366 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
10367 ! write (iout,*) "dxnormnormsafe",dsqrt(
10368 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
10369 if (.not.split_ene) then
10370 call etotal(energia1)
10372 ggg(j+3)=(etot1-etot2)/(2*aincr)
10375 call etotal_long(energia1)
10377 ggg(j+3)=(etot11-etot21)/(2*aincr)
10378 call etotal_short(energia1)
10380 ggg1(j+3)=(etot12-etot22)/(2*aincr)
10381 !- end split gradient
10383 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10384 dc(j,i+nres)=ddx(j)
10385 call chainbuild_cart
10387 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10388 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
10389 if (split_ene) then
10390 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10391 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
10393 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10394 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
10395 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
10399 end subroutine check_ecartint
10400 !-----------------------------------------------------------------------------
10401 subroutine check_eint
10402 ! Check the gradient of energy in internal coordinates.
10403 ! implicit real*8 (a-h,o-z)
10404 ! include 'DIMENSIONS'
10405 ! include 'COMMON.CHAIN'
10406 ! include 'COMMON.DERIV'
10407 ! include 'COMMON.IOUNITS'
10408 ! include 'COMMON.VAR'
10409 ! include 'COMMON.GEO'
10411 !el integer :: icall
10412 !el common /srutu/ icall
10413 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
10414 integer :: uiparm(1)
10415 real(kind=8) :: urparm(1)
10416 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
10417 character(len=6) :: key
10420 real(kind=8) :: xi,aincr,etot,etot1,etot2
10423 print '(a)','Calling CHECK_INT.'
10424 write(iout,*) 'Calling CHECK_INT.'
10428 call geom_to_var(nvar,x)
10429 call var_to_geom(nvar,x)
10431 write(iout,*) 'Calling CHECK_INT.'
10434 call etotal(energia)
10436 !el call enerprint(energia)
10439 if (MyID.ne.BossID) then
10440 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
10448 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
10449 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
10450 write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
10454 x(i)=xi-0.5D0*aincr
10455 call var_to_geom(nvar,x)
10457 call etotal(energia1)
10459 x(i)=xi+0.5D0*aincr
10460 call var_to_geom(nvar,x)
10462 call etotal(energia2)
10464 gg(i)=(etot2-etot1)/aincr
10465 write (iout,*) i,etot1,etot2
10468 write (iout,'(/2a)')' Variable Numerical Analytical',&
10471 if (i.le.nphi) then
10474 else if (i.le.nphi+ntheta) then
10477 else if (i.le.nphi+ntheta+nside) then
10481 ii=i-(nphi+ntheta+nside)
10484 write (iout,'(i3,a,i3,3(1pd16.6))') &
10485 i,key,ii,gg(i),gana(i),&
10486 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
10488 write(iout,*) "jestesmy sobie w check eint!!"
10490 end subroutine check_eint
10491 !-----------------------------------------------------------------------------
10493 !-----------------------------------------------------------------------------
10494 subroutine Econstr_back
10495 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
10496 ! implicit real*8 (a-h,o-z)
10497 ! include 'DIMENSIONS'
10498 ! include 'COMMON.CONTROL'
10499 ! include 'COMMON.VAR'
10500 ! include 'COMMON.MD'
10503 ! include 'COMMON.LANGEVIN'
10505 ! include 'COMMON.LANGEVIN.lang0'
10507 ! include 'COMMON.CHAIN'
10508 ! include 'COMMON.DERIV'
10509 ! include 'COMMON.GEO'
10510 ! include 'COMMON.LOCAL'
10511 ! include 'COMMON.INTERACT'
10512 ! include 'COMMON.IOUNITS'
10513 ! include 'COMMON.NAMES'
10514 ! include 'COMMON.TIME1'
10515 integer :: i,j,ii,k
10516 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
10518 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
10519 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
10520 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
10527 duscdiff(j,i)=0.0d0
10528 duscdiffx(j,i)=0.0d0
10532 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
10534 ! Deviations from theta angles
10537 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
10538 dtheta_i=theta(j)-thetaref(j)
10539 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
10540 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
10542 utheta(i)=utheta_i/(ii-1)
10544 ! Deviations from gamma angles
10547 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
10548 dgamma_i=pinorm(phi(j)-phiref(j))
10549 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
10550 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
10551 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
10552 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
10554 ugamma(i)=ugamma_i/(ii-2)
10556 ! Deviations from local SC geometry
10559 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
10560 dxx=xxtab(j)-xxref(j)
10561 dyy=yytab(j)-yyref(j)
10562 dzz=zztab(j)-zzref(j)
10563 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
10565 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
10566 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
10568 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
10569 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
10571 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
10572 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
10575 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
10576 ! & xxref(j),yyref(j),zzref(j)
10578 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
10579 ! write (iout,*) i," uscdiff",uscdiff(i)
10581 ! Put together deviations from local geometry
10583 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
10584 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
10585 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
10586 ! & " uconst_back",uconst_back
10587 utheta(i)=dsqrt(utheta(i))
10588 ugamma(i)=dsqrt(ugamma(i))
10589 uscdiff(i)=dsqrt(uscdiff(i))
10592 end subroutine Econstr_back
10593 !-----------------------------------------------------------------------------
10594 ! energy_p_new-sep_barrier.F
10595 !-----------------------------------------------------------------------------
10596 real(kind=8) function sscale(r)
10597 ! include "COMMON.SPLITELE"
10598 real(kind=8) :: r,gamm
10599 if(r.lt.r_cut-rlamb) then
10601 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10602 gamm=(r-(r_cut-rlamb))/rlamb
10603 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
10608 end function sscale
10609 !-----------------------------------------------------------------------------
10610 subroutine elj_long(evdw)
10612 ! This subroutine calculates the interaction energy of nonbonded side chains
10613 ! assuming the LJ potential of interaction.
10615 ! implicit real*8 (a-h,o-z)
10616 ! include 'DIMENSIONS'
10617 ! include 'COMMON.GEO'
10618 ! include 'COMMON.VAR'
10619 ! include 'COMMON.LOCAL'
10620 ! include 'COMMON.CHAIN'
10621 ! include 'COMMON.DERIV'
10622 ! include 'COMMON.INTERACT'
10623 ! include 'COMMON.TORSION'
10624 ! include 'COMMON.SBRIDGE'
10625 ! include 'COMMON.NAMES'
10626 ! include 'COMMON.IOUNITS'
10627 ! include 'COMMON.CONTACTS'
10628 real(kind=8),parameter :: accur=1.0d-10
10629 real(kind=8),dimension(3) :: gg
10630 !el local variables
10631 integer :: i,iint,j,k,itypi,itypi1,itypj
10632 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
10633 real(kind=8) :: e1,e2,evdwij,evdw
10634 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
10636 do i=iatsc_s,iatsc_e
10638 if (itypi.eq.ntyp1) cycle
10644 ! Calculate SC interaction energy.
10646 do iint=1,nint_gr(i)
10647 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
10648 !d & 'iend=',iend(i,iint)
10649 do j=istart(i,iint),iend(i,iint)
10651 if (itypj.eq.ntyp1) cycle
10655 rij=xj*xj+yj*yj+zj*zj
10656 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
10657 if (sss.lt.1.0d0) then
10659 eps0ij=eps(itypi,itypj)
10661 e1=fac*fac*aa(itypi,itypj)
10662 e2=fac*bb(itypi,itypj)
10664 evdw=evdw+(1.0d0-sss)*evdwij
10666 ! Calculate the components of the gradient in DC and X
10668 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
10673 gvdwx(k,i)=gvdwx(k,i)-gg(k)
10674 gvdwx(k,j)=gvdwx(k,j)+gg(k)
10675 gvdwc(k,i)=gvdwc(k,i)-gg(k)
10676 gvdwc(k,j)=gvdwc(k,j)+gg(k)
10684 gvdwc(j,i)=expon*gvdwc(j,i)
10685 gvdwx(j,i)=expon*gvdwx(j,i)
10688 !******************************************************************************
10692 ! To save time, the factor of EXPON has been extracted from ALL components
10693 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
10696 !******************************************************************************
10698 end subroutine elj_long
10699 !-----------------------------------------------------------------------------
10700 subroutine elj_short(evdw)
10702 ! This subroutine calculates the interaction energy of nonbonded side chains
10703 ! assuming the LJ potential of interaction.
10705 ! implicit real*8 (a-h,o-z)
10706 ! include 'DIMENSIONS'
10707 ! include 'COMMON.GEO'
10708 ! include 'COMMON.VAR'
10709 ! include 'COMMON.LOCAL'
10710 ! include 'COMMON.CHAIN'
10711 ! include 'COMMON.DERIV'
10712 ! include 'COMMON.INTERACT'
10713 ! include 'COMMON.TORSION'
10714 ! include 'COMMON.SBRIDGE'
10715 ! include 'COMMON.NAMES'
10716 ! include 'COMMON.IOUNITS'
10717 ! include 'COMMON.CONTACTS'
10718 real(kind=8),parameter :: accur=1.0d-10
10719 real(kind=8),dimension(3) :: gg
10720 !el local variables
10721 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
10722 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
10723 real(kind=8) :: e1,e2,evdwij,evdw
10724 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
10726 do i=iatsc_s,iatsc_e
10728 if (itypi.eq.ntyp1) cycle
10736 ! Calculate SC interaction energy.
10738 do iint=1,nint_gr(i)
10739 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
10740 !d & 'iend=',iend(i,iint)
10741 do j=istart(i,iint),iend(i,iint)
10743 if (itypj.eq.ntyp1) cycle
10747 ! Change 12/1/95 to calculate four-body interactions
10748 rij=xj*xj+yj*yj+zj*zj
10749 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
10750 if (sss.gt.0.0d0) then
10752 eps0ij=eps(itypi,itypj)
10754 e1=fac*fac*aa(itypi,itypj)
10755 e2=fac*bb(itypi,itypj)
10757 evdw=evdw+sss*evdwij
10759 ! Calculate the components of the gradient in DC and X
10761 fac=-rrij*(e1+evdwij)*sss
10766 gvdwx(k,i)=gvdwx(k,i)-gg(k)
10767 gvdwx(k,j)=gvdwx(k,j)+gg(k)
10768 gvdwc(k,i)=gvdwc(k,i)-gg(k)
10769 gvdwc(k,j)=gvdwc(k,j)+gg(k)
10777 gvdwc(j,i)=expon*gvdwc(j,i)
10778 gvdwx(j,i)=expon*gvdwx(j,i)
10781 !******************************************************************************
10785 ! To save time, the factor of EXPON has been extracted from ALL components
10786 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
10789 !******************************************************************************
10791 end subroutine elj_short
10792 !-----------------------------------------------------------------------------
10793 subroutine eljk_long(evdw)
10795 ! This subroutine calculates the interaction energy of nonbonded side chains
10796 ! assuming the LJK potential of interaction.
10798 ! implicit real*8 (a-h,o-z)
10799 ! include 'DIMENSIONS'
10800 ! include 'COMMON.GEO'
10801 ! include 'COMMON.VAR'
10802 ! include 'COMMON.LOCAL'
10803 ! include 'COMMON.CHAIN'
10804 ! include 'COMMON.DERIV'
10805 ! include 'COMMON.INTERACT'
10806 ! include 'COMMON.IOUNITS'
10807 ! include 'COMMON.NAMES'
10808 real(kind=8),dimension(3) :: gg
10810 !el local variables
10811 integer :: i,iint,j,k,itypi,itypi1,itypj
10812 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
10813 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
10814 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
10816 do i=iatsc_s,iatsc_e
10818 if (itypi.eq.ntyp1) cycle
10824 ! Calculate SC interaction energy.
10826 do iint=1,nint_gr(i)
10827 do j=istart(i,iint),iend(i,iint)
10829 if (itypj.eq.ntyp1) cycle
10833 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
10834 fac_augm=rrij**expon
10835 e_augm=augm(itypi,itypj)*fac_augm
10836 r_inv_ij=dsqrt(rrij)
10838 sss=sscale(rij/sigma(itypi,itypj))
10839 if (sss.lt.1.0d0) then
10840 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
10841 fac=r_shift_inv**expon
10842 e1=fac*fac*aa(itypi,itypj)
10843 e2=fac*bb(itypi,itypj)
10844 evdwij=e_augm+e1+e2
10845 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
10846 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
10847 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
10848 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
10849 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
10850 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
10851 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
10852 evdw=evdw+(1.0d0-sss)*evdwij
10854 ! Calculate the components of the gradient in DC and X
10856 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
10857 fac=fac*(1.0d0-sss)
10862 gvdwx(k,i)=gvdwx(k,i)-gg(k)
10863 gvdwx(k,j)=gvdwx(k,j)+gg(k)
10864 gvdwc(k,i)=gvdwc(k,i)-gg(k)
10865 gvdwc(k,j)=gvdwc(k,j)+gg(k)
10873 gvdwc(j,i)=expon*gvdwc(j,i)
10874 gvdwx(j,i)=expon*gvdwx(j,i)
10878 end subroutine eljk_long
10879 !-----------------------------------------------------------------------------
10880 subroutine eljk_short(evdw)
10882 ! This subroutine calculates the interaction energy of nonbonded side chains
10883 ! assuming the LJK potential of interaction.
10885 ! implicit real*8 (a-h,o-z)
10886 ! include 'DIMENSIONS'
10887 ! include 'COMMON.GEO'
10888 ! include 'COMMON.VAR'
10889 ! include 'COMMON.LOCAL'
10890 ! include 'COMMON.CHAIN'
10891 ! include 'COMMON.DERIV'
10892 ! include 'COMMON.INTERACT'
10893 ! include 'COMMON.IOUNITS'
10894 ! include 'COMMON.NAMES'
10895 real(kind=8),dimension(3) :: gg
10897 !el local variables
10898 integer :: i,iint,j,k,itypi,itypi1,itypj
10899 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
10900 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
10901 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
10903 do i=iatsc_s,iatsc_e
10905 if (itypi.eq.ntyp1) cycle
10911 ! Calculate SC interaction energy.
10913 do iint=1,nint_gr(i)
10914 do j=istart(i,iint),iend(i,iint)
10916 if (itypj.eq.ntyp1) cycle
10920 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
10921 fac_augm=rrij**expon
10922 e_augm=augm(itypi,itypj)*fac_augm
10923 r_inv_ij=dsqrt(rrij)
10925 sss=sscale(rij/sigma(itypi,itypj))
10926 if (sss.gt.0.0d0) then
10927 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
10928 fac=r_shift_inv**expon
10929 e1=fac*fac*aa(itypi,itypj)
10930 e2=fac*bb(itypi,itypj)
10931 evdwij=e_augm+e1+e2
10932 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
10933 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
10934 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
10935 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
10936 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
10937 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
10938 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
10939 evdw=evdw+sss*evdwij
10941 ! Calculate the components of the gradient in DC and X
10943 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
10949 gvdwx(k,i)=gvdwx(k,i)-gg(k)
10950 gvdwx(k,j)=gvdwx(k,j)+gg(k)
10951 gvdwc(k,i)=gvdwc(k,i)-gg(k)
10952 gvdwc(k,j)=gvdwc(k,j)+gg(k)
10960 gvdwc(j,i)=expon*gvdwc(j,i)
10961 gvdwx(j,i)=expon*gvdwx(j,i)
10965 end subroutine eljk_short
10966 !-----------------------------------------------------------------------------
10967 subroutine ebp_long(evdw)
10969 ! This subroutine calculates the interaction energy of nonbonded side chains
10970 ! assuming the Berne-Pechukas potential of interaction.
10973 ! implicit real*8 (a-h,o-z)
10974 ! include 'DIMENSIONS'
10975 ! include 'COMMON.GEO'
10976 ! include 'COMMON.VAR'
10977 ! include 'COMMON.LOCAL'
10978 ! include 'COMMON.CHAIN'
10979 ! include 'COMMON.DERIV'
10980 ! include 'COMMON.NAMES'
10981 ! include 'COMMON.INTERACT'
10982 ! include 'COMMON.IOUNITS'
10983 ! include 'COMMON.CALC'
10985 !el integer :: icall
10986 !el common /srutu/ icall
10987 ! double precision rrsave(maxdim)
10989 !el local variables
10990 integer :: iint,itypi,itypi1,itypj
10991 real(kind=8) :: rrij,xi,yi,zi,fac
10992 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
10994 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
10996 ! if (icall.eq.0) then
11002 do i=iatsc_s,iatsc_e
11004 if (itypi.eq.ntyp1) cycle
11009 dxi=dc_norm(1,nres+i)
11010 dyi=dc_norm(2,nres+i)
11011 dzi=dc_norm(3,nres+i)
11012 ! dsci_inv=dsc_inv(itypi)
11013 dsci_inv=vbld_inv(i+nres)
11015 ! Calculate SC interaction energy.
11017 do iint=1,nint_gr(i)
11018 do j=istart(i,iint),iend(i,iint)
11021 if (itypj.eq.ntyp1) cycle
11022 ! dscj_inv=dsc_inv(itypj)
11023 dscj_inv=vbld_inv(j+nres)
11024 chi1=chi(itypi,itypj)
11025 chi2=chi(itypj,itypi)
11032 alf12=0.5D0*(alf1+alf2)
11036 dxj=dc_norm(1,nres+j)
11037 dyj=dc_norm(2,nres+j)
11038 dzj=dc_norm(3,nres+j)
11039 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11041 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11043 if (sss.lt.1.0d0) then
11045 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
11047 ! Calculate whole angle-dependent part of epsilon and contributions
11048 ! to its derivatives
11049 fac=(rrij*sigsq)**expon2
11050 e1=fac*fac*aa(itypi,itypj)
11051 e2=fac*bb(itypi,itypj)
11052 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11053 eps2der=evdwij*eps3rt
11054 eps3der=evdwij*eps2rt
11055 evdwij=evdwij*eps2rt*eps3rt
11056 evdw=evdw+evdwij*(1.0d0-sss)
11058 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11059 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11060 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
11061 !d & restyp(itypi),i,restyp(itypj),j,
11062 !d & epsi,sigm,chi1,chi2,chip1,chip2,
11063 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
11064 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
11067 ! Calculate gradient components.
11068 e1=e1*eps1*eps2rt**2*eps3rt**2
11069 fac=-expon*(e1+evdwij)
11072 ! Calculate radial part of the gradient
11076 ! Calculate the angular part of the gradient and sum add the contributions
11077 ! to the appropriate components of the Cartesian gradient.
11078 call sc_grad_scale(1.0d0-sss)
11085 end subroutine ebp_long
11086 !-----------------------------------------------------------------------------
11087 subroutine ebp_short(evdw)
11089 ! This subroutine calculates the interaction energy of nonbonded side chains
11090 ! assuming the Berne-Pechukas potential of interaction.
11093 ! implicit real*8 (a-h,o-z)
11094 ! include 'DIMENSIONS'
11095 ! include 'COMMON.GEO'
11096 ! include 'COMMON.VAR'
11097 ! include 'COMMON.LOCAL'
11098 ! include 'COMMON.CHAIN'
11099 ! include 'COMMON.DERIV'
11100 ! include 'COMMON.NAMES'
11101 ! include 'COMMON.INTERACT'
11102 ! include 'COMMON.IOUNITS'
11103 ! include 'COMMON.CALC'
11105 !el integer :: icall
11106 !el common /srutu/ icall
11107 ! double precision rrsave(maxdim)
11109 !el local variables
11110 integer :: iint,itypi,itypi1,itypj
11111 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
11112 real(kind=8) :: sss,e1,e2,evdw
11114 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
11116 ! if (icall.eq.0) then
11122 do i=iatsc_s,iatsc_e
11124 if (itypi.eq.ntyp1) cycle
11129 dxi=dc_norm(1,nres+i)
11130 dyi=dc_norm(2,nres+i)
11131 dzi=dc_norm(3,nres+i)
11132 ! dsci_inv=dsc_inv(itypi)
11133 dsci_inv=vbld_inv(i+nres)
11135 ! Calculate SC interaction energy.
11137 do iint=1,nint_gr(i)
11138 do j=istart(i,iint),iend(i,iint)
11141 if (itypj.eq.ntyp1) cycle
11142 ! dscj_inv=dsc_inv(itypj)
11143 dscj_inv=vbld_inv(j+nres)
11144 chi1=chi(itypi,itypj)
11145 chi2=chi(itypj,itypi)
11152 alf12=0.5D0*(alf1+alf2)
11156 dxj=dc_norm(1,nres+j)
11157 dyj=dc_norm(2,nres+j)
11158 dzj=dc_norm(3,nres+j)
11159 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11161 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11163 if (sss.gt.0.0d0) then
11165 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
11167 ! Calculate whole angle-dependent part of epsilon and contributions
11168 ! to its derivatives
11169 fac=(rrij*sigsq)**expon2
11170 e1=fac*fac*aa(itypi,itypj)
11171 e2=fac*bb(itypi,itypj)
11172 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11173 eps2der=evdwij*eps3rt
11174 eps3der=evdwij*eps2rt
11175 evdwij=evdwij*eps2rt*eps3rt
11176 evdw=evdw+evdwij*sss
11178 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11179 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11180 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
11181 !d & restyp(itypi),i,restyp(itypj),j,
11182 !d & epsi,sigm,chi1,chi2,chip1,chip2,
11183 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
11184 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
11187 ! Calculate gradient components.
11188 e1=e1*eps1*eps2rt**2*eps3rt**2
11189 fac=-expon*(e1+evdwij)
11192 ! Calculate radial part of the gradient
11196 ! Calculate the angular part of the gradient and sum add the contributions
11197 ! to the appropriate components of the Cartesian gradient.
11198 call sc_grad_scale(sss)
11205 end subroutine ebp_short
11206 !-----------------------------------------------------------------------------
11207 subroutine egb_long(evdw)
11209 ! This subroutine calculates the interaction energy of nonbonded side chains
11210 ! assuming the Gay-Berne potential of interaction.
11213 ! implicit real*8 (a-h,o-z)
11214 ! include 'DIMENSIONS'
11215 ! include 'COMMON.GEO'
11216 ! include 'COMMON.VAR'
11217 ! include 'COMMON.LOCAL'
11218 ! include 'COMMON.CHAIN'
11219 ! include 'COMMON.DERIV'
11220 ! include 'COMMON.NAMES'
11221 ! include 'COMMON.INTERACT'
11222 ! include 'COMMON.IOUNITS'
11223 ! include 'COMMON.CALC'
11224 ! include 'COMMON.CONTROL'
11226 !el local variables
11227 integer :: iint,itypi,itypi1,itypj
11228 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
11229 real(kind=8) :: sss,e1,e2,evdw
11231 !cccc energy_dec=.false.
11232 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11235 ! if (icall.eq.0) lprn=.false.
11237 do i=iatsc_s,iatsc_e
11239 if (itypi.eq.ntyp1) cycle
11244 dxi=dc_norm(1,nres+i)
11245 dyi=dc_norm(2,nres+i)
11246 dzi=dc_norm(3,nres+i)
11247 ! dsci_inv=dsc_inv(itypi)
11248 dsci_inv=vbld_inv(i+nres)
11249 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
11250 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
11252 ! Calculate SC interaction energy.
11254 do iint=1,nint_gr(i)
11255 do j=istart(i,iint),iend(i,iint)
11258 if (itypj.eq.ntyp1) cycle
11259 ! dscj_inv=dsc_inv(itypj)
11260 dscj_inv=vbld_inv(j+nres)
11261 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
11262 ! & 1.0d0/vbld(j+nres)
11263 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
11264 sig0ij=sigma(itypi,itypj)
11265 chi1=chi(itypi,itypj)
11266 chi2=chi(itypj,itypi)
11273 alf12=0.5D0*(alf1+alf2)
11277 dxj=dc_norm(1,nres+j)
11278 dyj=dc_norm(2,nres+j)
11279 dzj=dc_norm(3,nres+j)
11280 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11282 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11284 if (sss.lt.1.0d0) then
11286 ! Calculate angle-dependent terms of energy and contributions to their
11290 sig=sig0ij*dsqrt(sigsq)
11291 rij_shift=1.0D0/rij-sig+sig0ij
11292 ! for diagnostics; uncomment
11293 ! rij_shift=1.2*sig0ij
11294 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11295 if (rij_shift.le.0.0D0) then
11297 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
11298 !d & restyp(itypi),i,restyp(itypj),j,
11299 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
11303 !---------------------------------------------------------------
11304 rij_shift=1.0D0/rij_shift
11305 fac=rij_shift**expon
11306 e1=fac*fac*aa(itypi,itypj)
11307 e2=fac*bb(itypi,itypj)
11308 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11309 eps2der=evdwij*eps3rt
11310 eps3der=evdwij*eps2rt
11311 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
11312 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
11313 evdwij=evdwij*eps2rt*eps3rt
11314 evdw=evdw+evdwij*(1.0d0-sss)
11316 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11317 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11318 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11319 restyp(itypi),i,restyp(itypj),j,&
11320 epsi,sigm,chi1,chi2,chip1,chip2,&
11321 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
11322 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11326 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
11329 ! Calculate gradient components.
11330 e1=e1*eps1*eps2rt**2*eps3rt**2
11331 fac=-expon*(e1+evdwij)*rij_shift
11335 ! Calculate the radial part of the gradient
11339 ! Calculate angular part of the gradient.
11340 call sc_grad_scale(1.0d0-sss)
11345 ! write (iout,*) "Number of loop steps in EGB:",ind
11346 !ccc energy_dec=.false.
11348 end subroutine egb_long
11349 !-----------------------------------------------------------------------------
11350 subroutine egb_short(evdw)
11352 ! This subroutine calculates the interaction energy of nonbonded side chains
11353 ! assuming the Gay-Berne potential of interaction.
11356 ! implicit real*8 (a-h,o-z)
11357 ! include 'DIMENSIONS'
11358 ! include 'COMMON.GEO'
11359 ! include 'COMMON.VAR'
11360 ! include 'COMMON.LOCAL'
11361 ! include 'COMMON.CHAIN'
11362 ! include 'COMMON.DERIV'
11363 ! include 'COMMON.NAMES'
11364 ! include 'COMMON.INTERACT'
11365 ! include 'COMMON.IOUNITS'
11366 ! include 'COMMON.CALC'
11367 ! include 'COMMON.CONTROL'
11369 !el local variables
11370 integer :: iint,itypi,itypi1,itypj
11371 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
11372 real(kind=8) :: sss,e1,e2,evdw,rij_shift
11374 !cccc energy_dec=.false.
11375 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11378 ! if (icall.eq.0) lprn=.false.
11380 do i=iatsc_s,iatsc_e
11382 if (itypi.eq.ntyp1) cycle
11387 dxi=dc_norm(1,nres+i)
11388 dyi=dc_norm(2,nres+i)
11389 dzi=dc_norm(3,nres+i)
11390 ! dsci_inv=dsc_inv(itypi)
11391 dsci_inv=vbld_inv(i+nres)
11392 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
11393 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
11395 ! Calculate SC interaction energy.
11397 do iint=1,nint_gr(i)
11398 do j=istart(i,iint),iend(i,iint)
11401 if (itypj.eq.ntyp1) cycle
11402 ! dscj_inv=dsc_inv(itypj)
11403 dscj_inv=vbld_inv(j+nres)
11404 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
11405 ! & 1.0d0/vbld(j+nres)
11406 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
11407 sig0ij=sigma(itypi,itypj)
11408 chi1=chi(itypi,itypj)
11409 chi2=chi(itypj,itypi)
11416 alf12=0.5D0*(alf1+alf2)
11420 dxj=dc_norm(1,nres+j)
11421 dyj=dc_norm(2,nres+j)
11422 dzj=dc_norm(3,nres+j)
11423 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11425 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11427 if (sss.gt.0.0d0) then
11429 ! Calculate angle-dependent terms of energy and contributions to their
11433 sig=sig0ij*dsqrt(sigsq)
11434 rij_shift=1.0D0/rij-sig+sig0ij
11435 ! for diagnostics; uncomment
11436 ! rij_shift=1.2*sig0ij
11437 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11438 if (rij_shift.le.0.0D0) then
11440 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
11441 !d & restyp(itypi),i,restyp(itypj),j,
11442 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
11446 !---------------------------------------------------------------
11447 rij_shift=1.0D0/rij_shift
11448 fac=rij_shift**expon
11449 e1=fac*fac*aa(itypi,itypj)
11450 e2=fac*bb(itypi,itypj)
11451 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11452 eps2der=evdwij*eps3rt
11453 eps3der=evdwij*eps2rt
11454 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
11455 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
11456 evdwij=evdwij*eps2rt*eps3rt
11457 evdw=evdw+evdwij*sss
11459 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11460 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11461 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11462 restyp(itypi),i,restyp(itypj),j,&
11463 epsi,sigm,chi1,chi2,chip1,chip2,&
11464 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
11465 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11469 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
11472 ! Calculate gradient components.
11473 e1=e1*eps1*eps2rt**2*eps3rt**2
11474 fac=-expon*(e1+evdwij)*rij_shift
11478 ! Calculate the radial part of the gradient
11482 ! Calculate angular part of the gradient.
11483 call sc_grad_scale(sss)
11488 ! write (iout,*) "Number of loop steps in EGB:",ind
11489 !ccc energy_dec=.false.
11491 end subroutine egb_short
11492 !-----------------------------------------------------------------------------
11493 subroutine egbv_long(evdw)
11495 ! This subroutine calculates the interaction energy of nonbonded side chains
11496 ! assuming the Gay-Berne-Vorobjev potential of interaction.
11499 ! implicit real*8 (a-h,o-z)
11500 ! include 'DIMENSIONS'
11501 ! include 'COMMON.GEO'
11502 ! include 'COMMON.VAR'
11503 ! include 'COMMON.LOCAL'
11504 ! include 'COMMON.CHAIN'
11505 ! include 'COMMON.DERIV'
11506 ! include 'COMMON.NAMES'
11507 ! include 'COMMON.INTERACT'
11508 ! include 'COMMON.IOUNITS'
11509 ! include 'COMMON.CALC'
11511 !el integer :: icall
11512 !el common /srutu/ icall
11514 !el local variables
11515 integer :: iint,itypi,itypi1,itypj
11516 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
11517 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
11519 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11522 ! if (icall.eq.0) lprn=.true.
11524 do i=iatsc_s,iatsc_e
11526 if (itypi.eq.ntyp1) cycle
11531 dxi=dc_norm(1,nres+i)
11532 dyi=dc_norm(2,nres+i)
11533 dzi=dc_norm(3,nres+i)
11534 ! dsci_inv=dsc_inv(itypi)
11535 dsci_inv=vbld_inv(i+nres)
11537 ! Calculate SC interaction energy.
11539 do iint=1,nint_gr(i)
11540 do j=istart(i,iint),iend(i,iint)
11543 if (itypj.eq.ntyp1) cycle
11544 ! dscj_inv=dsc_inv(itypj)
11545 dscj_inv=vbld_inv(j+nres)
11546 sig0ij=sigma(itypi,itypj)
11547 r0ij=r0(itypi,itypj)
11548 chi1=chi(itypi,itypj)
11549 chi2=chi(itypj,itypi)
11556 alf12=0.5D0*(alf1+alf2)
11560 dxj=dc_norm(1,nres+j)
11561 dyj=dc_norm(2,nres+j)
11562 dzj=dc_norm(3,nres+j)
11563 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11566 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11568 if (sss.lt.1.0d0) then
11570 ! Calculate angle-dependent terms of energy and contributions to their
11574 sig=sig0ij*dsqrt(sigsq)
11575 rij_shift=1.0D0/rij-sig+r0ij
11576 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11577 if (rij_shift.le.0.0D0) then
11582 !---------------------------------------------------------------
11583 rij_shift=1.0D0/rij_shift
11584 fac=rij_shift**expon
11585 e1=fac*fac*aa(itypi,itypj)
11586 e2=fac*bb(itypi,itypj)
11587 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11588 eps2der=evdwij*eps3rt
11589 eps3der=evdwij*eps2rt
11590 fac_augm=rrij**expon
11591 e_augm=augm(itypi,itypj)*fac_augm
11592 evdwij=evdwij*eps2rt*eps3rt
11593 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
11595 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11596 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11597 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11598 restyp(itypi),i,restyp(itypj),j,&
11599 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
11600 chi1,chi2,chip1,chip2,&
11601 eps1,eps2rt**2,eps3rt**2,&
11602 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11605 ! Calculate gradient components.
11606 e1=e1*eps1*eps2rt**2*eps3rt**2
11607 fac=-expon*(e1+evdwij)*rij_shift
11609 fac=rij*fac-2*expon*rrij*e_augm
11610 ! Calculate the radial part of the gradient
11614 ! Calculate angular part of the gradient.
11615 call sc_grad_scale(1.0d0-sss)
11620 end subroutine egbv_long
11621 !-----------------------------------------------------------------------------
11622 subroutine egbv_short(evdw)
11624 ! This subroutine calculates the interaction energy of nonbonded side chains
11625 ! assuming the Gay-Berne-Vorobjev potential of interaction.
11628 ! implicit real*8 (a-h,o-z)
11629 ! include 'DIMENSIONS'
11630 ! include 'COMMON.GEO'
11631 ! include 'COMMON.VAR'
11632 ! include 'COMMON.LOCAL'
11633 ! include 'COMMON.CHAIN'
11634 ! include 'COMMON.DERIV'
11635 ! include 'COMMON.NAMES'
11636 ! include 'COMMON.INTERACT'
11637 ! include 'COMMON.IOUNITS'
11638 ! include 'COMMON.CALC'
11640 !el integer :: icall
11641 !el common /srutu/ icall
11643 !el local variables
11644 integer :: iint,itypi,itypi1,itypj
11645 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
11646 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
11648 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11651 ! if (icall.eq.0) lprn=.true.
11653 do i=iatsc_s,iatsc_e
11655 if (itypi.eq.ntyp1) cycle
11660 dxi=dc_norm(1,nres+i)
11661 dyi=dc_norm(2,nres+i)
11662 dzi=dc_norm(3,nres+i)
11663 ! dsci_inv=dsc_inv(itypi)
11664 dsci_inv=vbld_inv(i+nres)
11666 ! Calculate SC interaction energy.
11668 do iint=1,nint_gr(i)
11669 do j=istart(i,iint),iend(i,iint)
11672 if (itypj.eq.ntyp1) cycle
11673 ! dscj_inv=dsc_inv(itypj)
11674 dscj_inv=vbld_inv(j+nres)
11675 sig0ij=sigma(itypi,itypj)
11676 r0ij=r0(itypi,itypj)
11677 chi1=chi(itypi,itypj)
11678 chi2=chi(itypj,itypi)
11685 alf12=0.5D0*(alf1+alf2)
11689 dxj=dc_norm(1,nres+j)
11690 dyj=dc_norm(2,nres+j)
11691 dzj=dc_norm(3,nres+j)
11692 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11695 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11697 if (sss.gt.0.0d0) then
11699 ! Calculate angle-dependent terms of energy and contributions to their
11703 sig=sig0ij*dsqrt(sigsq)
11704 rij_shift=1.0D0/rij-sig+r0ij
11705 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11706 if (rij_shift.le.0.0D0) then
11711 !---------------------------------------------------------------
11712 rij_shift=1.0D0/rij_shift
11713 fac=rij_shift**expon
11714 e1=fac*fac*aa(itypi,itypj)
11715 e2=fac*bb(itypi,itypj)
11716 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11717 eps2der=evdwij*eps3rt
11718 eps3der=evdwij*eps2rt
11719 fac_augm=rrij**expon
11720 e_augm=augm(itypi,itypj)*fac_augm
11721 evdwij=evdwij*eps2rt*eps3rt
11722 evdw=evdw+(evdwij+e_augm)*sss
11724 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11725 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11726 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11727 restyp(itypi),i,restyp(itypj),j,&
11728 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
11729 chi1,chi2,chip1,chip2,&
11730 eps1,eps2rt**2,eps3rt**2,&
11731 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11734 ! Calculate gradient components.
11735 e1=e1*eps1*eps2rt**2*eps3rt**2
11736 fac=-expon*(e1+evdwij)*rij_shift
11738 fac=rij*fac-2*expon*rrij*e_augm
11739 ! Calculate the radial part of the gradient
11743 ! Calculate angular part of the gradient.
11744 call sc_grad_scale(sss)
11749 end subroutine egbv_short
11750 !-----------------------------------------------------------------------------
11751 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
11753 ! This subroutine calculates the average interaction energy and its gradient
11754 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
11755 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
11756 ! The potential depends both on the distance of peptide-group centers and on
11757 ! the orientation of the CA-CA virtual bonds.
11759 ! implicit real*8 (a-h,o-z)
11765 ! include 'DIMENSIONS'
11766 ! include 'COMMON.CONTROL'
11767 ! include 'COMMON.SETUP'
11768 ! include 'COMMON.IOUNITS'
11769 ! include 'COMMON.GEO'
11770 ! include 'COMMON.VAR'
11771 ! include 'COMMON.LOCAL'
11772 ! include 'COMMON.CHAIN'
11773 ! include 'COMMON.DERIV'
11774 ! include 'COMMON.INTERACT'
11775 ! include 'COMMON.CONTACTS'
11776 ! include 'COMMON.TORSION'
11777 ! include 'COMMON.VECTORS'
11778 ! include 'COMMON.FFIELD'
11779 ! include 'COMMON.TIME1'
11780 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
11781 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
11782 real(kind=8),dimension(2,2) :: acipa !el,a_temp
11783 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
11784 real(kind=8),dimension(4) :: muij
11785 !el integer :: num_conti,j1,j2
11786 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
11787 !el dz_normi,xmedi,ymedi,zmedi
11788 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
11789 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
11790 !el num_conti,j1,j2
11791 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
11793 real(kind=8) :: scal_el=1.0d0
11795 real(kind=8) :: scal_el=0.5d0
11798 ! 13-go grudnia roku pamietnego...
11799 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
11800 0.0d0,1.0d0,0.0d0,&
11801 0.0d0,0.0d0,1.0d0/),shape(unmat))
11802 !el local variables
11804 real(kind=8) :: fac
11805 real(kind=8) :: dxj,dyj,dzj
11806 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
11808 ! allocate(num_cont_hb(nres)) !(maxres)
11809 !d write(iout,*) 'In EELEC'
11811 !d write(iout,*) 'Type',i
11812 !d write(iout,*) 'B1',B1(:,i)
11813 !d write(iout,*) 'B2',B2(:,i)
11814 !d write(iout,*) 'CC',CC(:,:,i)
11815 !d write(iout,*) 'DD',DD(:,:,i)
11816 !d write(iout,*) 'EE',EE(:,:,i)
11818 !d call check_vecgrad
11820 if (icheckgrad.eq.1) then
11822 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
11824 dc_norm(k,i)=dc(k,i)*fac
11826 ! write (iout,*) 'i',i,' fac',fac
11829 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
11830 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
11831 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
11832 ! call vec_and_deriv
11838 time_mat=time_mat+MPI_Wtime()-time01
11842 !d write (iout,*) 'i=',i
11844 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
11847 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
11848 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
11861 !d print '(a)','Enter EELEC'
11862 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
11863 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
11864 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
11866 gel_loc_loc(i)=0.0d0
11871 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
11873 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
11875 do i=iturn3_start,iturn3_end
11876 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1 &
11877 .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
11881 dx_normi=dc_norm(1,i)
11882 dy_normi=dc_norm(2,i)
11883 dz_normi=dc_norm(3,i)
11884 xmedi=c(1,i)+0.5d0*dxi
11885 ymedi=c(2,i)+0.5d0*dyi
11886 zmedi=c(3,i)+0.5d0*dzi
11888 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
11889 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
11890 num_cont_hb(i)=num_conti
11892 do i=iturn4_start,iturn4_end
11893 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
11894 .or. itype(i+3).eq.ntyp1 &
11895 .or. itype(i+4).eq.ntyp1) cycle
11899 dx_normi=dc_norm(1,i)
11900 dy_normi=dc_norm(2,i)
11901 dz_normi=dc_norm(3,i)
11902 xmedi=c(1,i)+0.5d0*dxi
11903 ymedi=c(2,i)+0.5d0*dyi
11904 zmedi=c(3,i)+0.5d0*dzi
11905 num_conti=num_cont_hb(i)
11906 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
11907 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
11908 call eturn4(i,eello_turn4)
11909 num_cont_hb(i)=num_conti
11912 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
11914 do i=iatel_s,iatel_e
11915 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
11919 dx_normi=dc_norm(1,i)
11920 dy_normi=dc_norm(2,i)
11921 dz_normi=dc_norm(3,i)
11922 xmedi=c(1,i)+0.5d0*dxi
11923 ymedi=c(2,i)+0.5d0*dyi
11924 zmedi=c(3,i)+0.5d0*dzi
11925 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
11926 num_conti=num_cont_hb(i)
11927 do j=ielstart(i),ielend(i)
11928 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
11929 call eelecij_scale(i,j,ees,evdw1,eel_loc)
11931 num_cont_hb(i)=num_conti
11933 ! write (iout,*) "Number of loop steps in EELEC:",ind
11935 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
11936 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
11938 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
11939 !cc eel_loc=eel_loc+eello_turn3
11940 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
11942 end subroutine eelec_scale
11943 !-----------------------------------------------------------------------------
11944 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
11945 ! implicit real*8 (a-h,o-z)
11948 ! include 'DIMENSIONS'
11952 ! include 'COMMON.CONTROL'
11953 ! include 'COMMON.IOUNITS'
11954 ! include 'COMMON.GEO'
11955 ! include 'COMMON.VAR'
11956 ! include 'COMMON.LOCAL'
11957 ! include 'COMMON.CHAIN'
11958 ! include 'COMMON.DERIV'
11959 ! include 'COMMON.INTERACT'
11960 ! include 'COMMON.CONTACTS'
11961 ! include 'COMMON.TORSION'
11962 ! include 'COMMON.VECTORS'
11963 ! include 'COMMON.FFIELD'
11964 ! include 'COMMON.TIME1'
11965 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
11966 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
11967 real(kind=8),dimension(2,2) :: acipa !el,a_temp
11968 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
11969 real(kind=8),dimension(4) :: muij
11970 !el integer :: num_conti,j1,j2
11971 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
11972 !el dz_normi,xmedi,ymedi,zmedi
11973 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
11974 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
11975 !el num_conti,j1,j2
11976 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
11978 real(kind=8) :: scal_el=1.0d0
11980 real(kind=8) :: scal_el=0.5d0
11983 ! 13-go grudnia roku pamietnego...
11984 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
11985 0.0d0,1.0d0,0.0d0,&
11986 0.0d0,0.0d0,1.0d0/),shape(unmat))
11987 !el local variables
11988 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m
11989 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
11990 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
11991 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
11992 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
11993 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
11994 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
11995 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
11996 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
11997 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
11998 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
11999 ecosam,ecosbm,ecosgm,ghalf,time00
12000 ! integer :: maxconts
12001 ! maxconts = nres/4
12002 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12003 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12004 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12005 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12006 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12007 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12008 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12009 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12010 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
12011 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
12012 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
12013 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
12014 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
12016 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
12017 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
12022 !d write (iout,*) "eelecij",i,j
12026 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
12027 aaa=app(iteli,itelj)
12028 bbb=bpp(iteli,itelj)
12029 ael6i=ael6(iteli,itelj)
12030 ael3i=ael3(iteli,itelj)
12034 dx_normj=dc_norm(1,j)
12035 dy_normj=dc_norm(2,j)
12036 dz_normj=dc_norm(3,j)
12037 xj=c(1,j)+0.5D0*dxj-xmedi
12038 yj=c(2,j)+0.5D0*dyj-ymedi
12039 zj=c(3,j)+0.5D0*dzj-zmedi
12040 rij=xj*xj+yj*yj+zj*zj
12044 ! For extracting the short-range part of Evdwpp
12045 sss=sscale(rij/rpp(iteli,itelj))
12049 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
12050 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
12051 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
12052 fac=cosa-3.0D0*cosb*cosg
12054 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
12055 if (j.eq.i+2) ev1=scal_el*ev1
12060 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
12063 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
12064 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
12066 evdw1=evdw1+evdwij*(1.0d0-sss)
12067 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
12068 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
12069 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
12070 !d & xmedi,ymedi,zmedi,xj,yj,zj
12072 if (energy_dec) then
12073 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
12074 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
12078 ! Calculate contributions to the Cartesian gradient.
12081 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)
12082 facel=-3*rrmij*(el1+eesij)
12088 ! Radial derivatives. First process both termini of the fragment (i,j)
12094 ! ghalf=0.5D0*ggg(k)
12095 ! gelc(k,i)=gelc(k,i)+ghalf
12096 ! gelc(k,j)=gelc(k,j)+ghalf
12098 ! 9/28/08 AL Gradient compotents will be summed only at the end
12100 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
12101 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
12104 ! Loop over residues i+1 thru j-1.
12108 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12115 ! ghalf=0.5D0*ggg(k)
12116 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
12117 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
12119 ! 9/28/08 AL Gradient compotents will be summed only at the end
12121 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12122 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12125 ! Loop over residues i+1 thru j-1.
12129 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
12133 facvdw=ev1+evdwij*(1.0d0-sss)
12136 fac=-3*rrmij*(facvdw+facvdw+facel)
12141 ! Radial derivatives. First process both termini of the fragment (i,j)
12147 ! ghalf=0.5D0*ggg(k)
12148 ! gelc(k,i)=gelc(k,i)+ghalf
12149 ! gelc(k,j)=gelc(k,j)+ghalf
12151 ! 9/28/08 AL Gradient compotents will be summed only at the end
12153 gelc_long(k,j)=gelc(k,j)+ggg(k)
12154 gelc_long(k,i)=gelc(k,i)-ggg(k)
12157 ! Loop over residues i+1 thru j-1.
12161 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12164 ! 9/28/08 AL Gradient compotents will be summed only at the end
12169 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12170 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12176 ecosa=2.0D0*fac3*fac1+fac4
12179 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
12180 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
12182 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
12183 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
12185 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
12186 !d & (dcosg(k),k=1,3)
12188 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
12191 ! ghalf=0.5D0*ggg(k)
12192 ! gelc(k,i)=gelc(k,i)+ghalf
12193 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
12194 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12195 ! gelc(k,j)=gelc(k,j)+ghalf
12196 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
12197 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12201 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12205 gelc(k,i)=gelc(k,i) &
12206 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
12207 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12208 gelc(k,j)=gelc(k,j) &
12209 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
12210 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12211 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
12212 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
12214 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
12215 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
12216 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
12218 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
12219 ! energy of a peptide unit is assumed in the form of a second-order
12220 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
12221 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
12222 ! are computed for EVERY pair of non-contiguous peptide groups.
12224 if (j.lt.nres-1) then
12235 muij(kkk)=mu(k,i)*mu(l,j)
12238 !d write (iout,*) 'EELEC: i',i,' j',j
12239 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
12240 !d write(iout,*) 'muij',muij
12241 ury=scalar(uy(1,i),erij)
12242 urz=scalar(uz(1,i),erij)
12243 vry=scalar(uy(1,j),erij)
12244 vrz=scalar(uz(1,j),erij)
12245 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
12246 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
12247 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
12248 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
12249 fac=dsqrt(-ael6i)*r3ij
12254 !d write (iout,'(4i5,4f10.5)')
12255 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
12256 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
12257 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
12258 !d & uy(:,j),uz(:,j)
12259 !d write (iout,'(4f10.5)')
12260 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
12261 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
12262 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
12263 !d write (iout,'(9f10.5/)')
12264 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
12265 ! Derivatives of the elements of A in virtual-bond vectors
12266 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
12268 uryg(k,1)=scalar(erder(1,k),uy(1,i))
12269 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
12270 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
12271 urzg(k,1)=scalar(erder(1,k),uz(1,i))
12272 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
12273 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
12274 vryg(k,1)=scalar(erder(1,k),uy(1,j))
12275 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
12276 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
12277 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
12278 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
12279 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
12281 ! Compute radial contributions to the gradient
12299 ! Add the contributions coming from er
12302 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
12303 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
12304 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
12305 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
12308 ! Derivatives in DC(i)
12309 !grad ghalf1=0.5d0*agg(k,1)
12310 !grad ghalf2=0.5d0*agg(k,2)
12311 !grad ghalf3=0.5d0*agg(k,3)
12312 !grad ghalf4=0.5d0*agg(k,4)
12313 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
12314 -3.0d0*uryg(k,2)*vry)!+ghalf1
12315 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
12316 -3.0d0*uryg(k,2)*vrz)!+ghalf2
12317 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
12318 -3.0d0*urzg(k,2)*vry)!+ghalf3
12319 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
12320 -3.0d0*urzg(k,2)*vrz)!+ghalf4
12321 ! Derivatives in DC(i+1)
12322 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
12323 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
12324 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
12325 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
12326 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
12327 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
12328 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
12329 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
12330 ! Derivatives in DC(j)
12331 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
12332 -3.0d0*vryg(k,2)*ury)!+ghalf1
12333 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
12334 -3.0d0*vrzg(k,2)*ury)!+ghalf2
12335 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
12336 -3.0d0*vryg(k,2)*urz)!+ghalf3
12337 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
12338 -3.0d0*vrzg(k,2)*urz)!+ghalf4
12339 ! Derivatives in DC(j+1) or DC(nres-1)
12340 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
12341 -3.0d0*vryg(k,3)*ury)
12342 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
12343 -3.0d0*vrzg(k,3)*ury)
12344 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
12345 -3.0d0*vryg(k,3)*urz)
12346 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
12347 -3.0d0*vrzg(k,3)*urz)
12348 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
12350 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
12363 aggi(k,l)=-aggi(k,l)
12364 aggi1(k,l)=-aggi1(k,l)
12365 aggj(k,l)=-aggj(k,l)
12366 aggj1(k,l)=-aggj1(k,l)
12369 if (j.lt.nres-1) then
12375 aggi(k,l)=-aggi(k,l)
12376 aggi1(k,l)=-aggi1(k,l)
12377 aggj(k,l)=-aggj(k,l)
12378 aggj1(k,l)=-aggj1(k,l)
12389 aggi(k,l)=-aggi(k,l)
12390 aggi1(k,l)=-aggi1(k,l)
12391 aggj(k,l)=-aggj(k,l)
12392 aggj1(k,l)=-aggj1(k,l)
12397 IF (wel_loc.gt.0.0d0) THEN
12398 ! Contribution to the local-electrostatic energy coming from the i-j pair
12399 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
12401 !d write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
12403 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
12404 'eelloc',i,j,eel_loc_ij
12405 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
12407 eel_loc=eel_loc+eel_loc_ij
12408 ! Partial derivatives in virtual-bond dihedral angles gamma
12410 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
12411 a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
12412 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
12413 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
12414 a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
12415 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
12416 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
12418 ggg(l)=agg(l,1)*muij(1)+ &
12419 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
12420 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
12421 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
12422 !grad ghalf=0.5d0*ggg(l)
12423 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
12424 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
12428 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
12431 ! Remaining derivatives of eello
12433 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ &
12434 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
12435 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ &
12436 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
12437 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ &
12438 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
12439 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ &
12440 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
12443 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
12444 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
12445 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
12446 .and. num_conti.le.maxconts) then
12447 ! write (iout,*) i,j," entered corr"
12449 ! Calculate the contact function. The ith column of the array JCONT will
12450 ! contain the numbers of atoms that make contacts with the atom I (of numbers
12451 ! greater than I). The arrays FACONT and GACONT will contain the values of
12452 ! the contact function and its derivative.
12453 ! r0ij=1.02D0*rpp(iteli,itelj)
12454 ! r0ij=1.11D0*rpp(iteli,itelj)
12455 r0ij=2.20D0*rpp(iteli,itelj)
12456 ! r0ij=1.55D0*rpp(iteli,itelj)
12457 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
12458 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
12459 if (fcont.gt.0.0D0) then
12460 num_conti=num_conti+1
12461 if (num_conti.gt.maxconts) then
12462 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
12463 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
12464 ' will skip next contacts for this conf.',num_conti
12466 jcont_hb(num_conti,i)=j
12467 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
12468 !d & " jcont_hb",jcont_hb(num_conti,i)
12469 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
12470 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
12471 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
12473 d_cont(num_conti,i)=rij
12474 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
12475 ! --- Electrostatic-interaction matrix ---
12476 a_chuj(1,1,num_conti,i)=a22
12477 a_chuj(1,2,num_conti,i)=a23
12478 a_chuj(2,1,num_conti,i)=a32
12479 a_chuj(2,2,num_conti,i)=a33
12480 ! --- Gradient of rij
12482 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
12489 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
12490 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
12491 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
12492 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
12493 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
12498 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
12499 ! Calculate contact energies
12501 wij=cosa-3.0D0*cosb*cosg
12504 ! fac3=dsqrt(-ael6i)/r0ij**3
12505 fac3=dsqrt(-ael6i)*r3ij
12506 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
12507 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
12508 if (ees0tmp.gt.0) then
12509 ees0pij=dsqrt(ees0tmp)
12513 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
12514 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
12515 if (ees0tmp.gt.0) then
12516 ees0mij=dsqrt(ees0tmp)
12521 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
12522 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
12523 ! Diagnostics. Comment out or remove after debugging!
12524 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
12525 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
12526 ! ees0m(num_conti,i)=0.0D0
12528 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
12529 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
12530 ! Angular derivatives of the contact function
12531 ees0pij1=fac3/ees0pij
12532 ees0mij1=fac3/ees0mij
12533 fac3p=-3.0D0*fac3*rrmij
12534 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
12535 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
12537 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
12538 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
12539 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
12540 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
12541 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
12542 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
12543 ecosap=ecosa1+ecosa2
12544 ecosbp=ecosb1+ecosb2
12545 ecosgp=ecosg1+ecosg2
12546 ecosam=ecosa1-ecosa2
12547 ecosbm=ecosb1-ecosb2
12548 ecosgm=ecosg1-ecosg2
12557 facont_hb(num_conti,i)=fcont
12558 fprimcont=fprimcont/rij
12559 !d facont_hb(num_conti,i)=1.0D0
12560 ! Following line is for diagnostics.
12563 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
12564 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
12567 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
12568 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
12570 gggp(1)=gggp(1)+ees0pijp*xj
12571 gggp(2)=gggp(2)+ees0pijp*yj
12572 gggp(3)=gggp(3)+ees0pijp*zj
12573 gggm(1)=gggm(1)+ees0mijp*xj
12574 gggm(2)=gggm(2)+ees0mijp*yj
12575 gggm(3)=gggm(3)+ees0mijp*zj
12576 ! Derivatives due to the contact function
12577 gacont_hbr(1,num_conti,i)=fprimcont*xj
12578 gacont_hbr(2,num_conti,i)=fprimcont*yj
12579 gacont_hbr(3,num_conti,i)=fprimcont*zj
12582 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
12583 ! following the change of gradient-summation algorithm.
12585 !grad ghalfp=0.5D0*gggp(k)
12586 !grad ghalfm=0.5D0*gggm(k)
12587 gacontp_hb1(k,num_conti,i)= & !ghalfp
12588 +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
12589 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12590 gacontp_hb2(k,num_conti,i)= & !ghalfp
12591 +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
12592 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12593 gacontp_hb3(k,num_conti,i)=gggp(k)
12594 gacontm_hb1(k,num_conti,i)= &!ghalfm
12595 +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
12596 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12597 gacontm_hb2(k,num_conti,i)= & !ghalfm
12598 +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
12599 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12600 gacontm_hb3(k,num_conti,i)=gggm(k)
12603 endif ! num_conti.le.maxconts
12606 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
12609 ghalf=0.5d0*agg(l,k)
12610 aggi(l,k)=aggi(l,k)+ghalf
12611 aggi1(l,k)=aggi1(l,k)+agg(l,k)
12612 aggj(l,k)=aggj(l,k)+ghalf
12615 if (j.eq.nres-1 .and. i.lt.j-2) then
12618 aggj1(l,k)=aggj1(l,k)+agg(l,k)
12623 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
12625 end subroutine eelecij_scale
12626 !-----------------------------------------------------------------------------
12627 subroutine evdwpp_short(evdw1)
12631 ! implicit real*8 (a-h,o-z)
12632 ! include 'DIMENSIONS'
12633 ! include 'COMMON.CONTROL'
12634 ! include 'COMMON.IOUNITS'
12635 ! include 'COMMON.GEO'
12636 ! include 'COMMON.VAR'
12637 ! include 'COMMON.LOCAL'
12638 ! include 'COMMON.CHAIN'
12639 ! include 'COMMON.DERIV'
12640 ! include 'COMMON.INTERACT'
12641 ! include 'COMMON.CONTACTS'
12642 ! include 'COMMON.TORSION'
12643 ! include 'COMMON.VECTORS'
12644 ! include 'COMMON.FFIELD'
12645 real(kind=8),dimension(3) :: ggg
12646 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
12648 real(kind=8) :: scal_el=1.0d0
12650 real(kind=8) :: scal_el=0.5d0
12652 !el local variables
12653 integer :: i,j,k,iteli,itelj,num_conti
12654 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
12655 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
12656 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
12657 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
12660 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
12661 ! & " iatel_e_vdw",iatel_e_vdw
12663 do i=iatel_s_vdw,iatel_e_vdw
12664 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle
12668 dx_normi=dc_norm(1,i)
12669 dy_normi=dc_norm(2,i)
12670 dz_normi=dc_norm(3,i)
12671 xmedi=c(1,i)+0.5d0*dxi
12672 ymedi=c(2,i)+0.5d0*dyi
12673 zmedi=c(3,i)+0.5d0*dzi
12675 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
12676 ! & ' ielend',ielend_vdw(i)
12678 do j=ielstart_vdw(i),ielend_vdw(i)
12679 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
12683 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
12684 aaa=app(iteli,itelj)
12685 bbb=bpp(iteli,itelj)
12689 dx_normj=dc_norm(1,j)
12690 dy_normj=dc_norm(2,j)
12691 dz_normj=dc_norm(3,j)
12692 xj=c(1,j)+0.5D0*dxj-xmedi
12693 yj=c(2,j)+0.5D0*dyj-ymedi
12694 zj=c(3,j)+0.5D0*dzj-zmedi
12695 rij=xj*xj+yj*yj+zj*zj
12698 sss=sscale(rij/rpp(iteli,itelj))
12699 if (sss.gt.0.0d0) then
12704 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
12705 if (j.eq.i+2) ev1=scal_el*ev1
12708 if (energy_dec) then
12709 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
12711 evdw1=evdw1+evdwij*sss
12713 ! Calculate contributions to the Cartesian gradient.
12715 facvdw=-6*rrmij*(ev1+evdwij)*sss
12720 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12721 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12727 end subroutine evdwpp_short
12728 !-----------------------------------------------------------------------------
12729 subroutine escp_long(evdw2,evdw2_14)
12731 ! This subroutine calculates the excluded-volume interaction energy between
12732 ! peptide-group centers and side chains and its gradient in virtual-bond and
12733 ! side-chain vectors.
12735 ! implicit real*8 (a-h,o-z)
12736 ! include 'DIMENSIONS'
12737 ! include 'COMMON.GEO'
12738 ! include 'COMMON.VAR'
12739 ! include 'COMMON.LOCAL'
12740 ! include 'COMMON.CHAIN'
12741 ! include 'COMMON.DERIV'
12742 ! include 'COMMON.INTERACT'
12743 ! include 'COMMON.FFIELD'
12744 ! include 'COMMON.IOUNITS'
12745 ! include 'COMMON.CONTROL'
12746 real(kind=8),dimension(3) :: ggg
12747 !el local variables
12748 integer :: i,iint,j,k,iteli,itypj
12749 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2
12750 real(kind=8) :: evdw2,evdw2_14,evdwij
12753 !d print '(a)','Enter ESCP'
12754 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
12755 do i=iatscp_s,iatscp_e
12756 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
12758 xi=0.5D0*(c(1,i)+c(1,i+1))
12759 yi=0.5D0*(c(2,i)+c(2,i+1))
12760 zi=0.5D0*(c(3,i)+c(3,i+1))
12762 do iint=1,nscp_gr(i)
12764 do j=iscpstart(i,iint),iscpend(i,iint)
12766 if (itypj.eq.ntyp1) cycle
12767 ! Uncomment following three lines for SC-p interactions
12768 ! xj=c(1,nres+j)-xi
12769 ! yj=c(2,nres+j)-yi
12770 ! zj=c(3,nres+j)-zi
12771 ! Uncomment following three lines for Ca-p interactions
12775 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12777 sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
12779 if (sss.lt.1.0d0) then
12782 e1=fac*fac*aad(itypj,iteli)
12783 e2=fac*bad(itypj,iteli)
12784 if (iabs(j-i) .le. 2) then
12787 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)
12790 evdw2=evdw2+evdwij*(1.0d0-sss)
12791 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
12792 'evdw2',i,j,sss,evdwij
12794 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
12796 fac=-(evdwij+e1)*rrij*(1.0d0-sss)
12800 ! Uncomment following three lines for SC-p interactions
12802 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
12804 ! Uncomment following line for SC-p interactions
12805 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
12807 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
12808 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
12817 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
12818 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
12819 gradx_scp(j,i)=expon*gradx_scp(j,i)
12822 !******************************************************************************
12826 ! To save time the factor EXPON has been extracted from ALL components
12827 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12830 !******************************************************************************
12832 end subroutine escp_long
12833 !-----------------------------------------------------------------------------
12834 subroutine escp_short(evdw2,evdw2_14)
12836 ! This subroutine calculates the excluded-volume interaction energy between
12837 ! peptide-group centers and side chains and its gradient in virtual-bond and
12838 ! side-chain vectors.
12840 ! implicit real*8 (a-h,o-z)
12841 ! include 'DIMENSIONS'
12842 ! include 'COMMON.GEO'
12843 ! include 'COMMON.VAR'
12844 ! include 'COMMON.LOCAL'
12845 ! include 'COMMON.CHAIN'
12846 ! include 'COMMON.DERIV'
12847 ! include 'COMMON.INTERACT'
12848 ! include 'COMMON.FFIELD'
12849 ! include 'COMMON.IOUNITS'
12850 ! include 'COMMON.CONTROL'
12851 real(kind=8),dimension(3) :: ggg
12852 !el local variables
12853 integer :: i,iint,j,k,iteli,itypj
12854 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2
12855 real(kind=8) :: evdw2,evdw2_14,evdwij
12858 !d print '(a)','Enter ESCP'
12859 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
12860 do i=iatscp_s,iatscp_e
12861 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
12863 xi=0.5D0*(c(1,i)+c(1,i+1))
12864 yi=0.5D0*(c(2,i)+c(2,i+1))
12865 zi=0.5D0*(c(3,i)+c(3,i+1))
12867 do iint=1,nscp_gr(i)
12869 do j=iscpstart(i,iint),iscpend(i,iint)
12871 if (itypj.eq.ntyp1) cycle
12872 ! Uncomment following three lines for SC-p interactions
12873 ! xj=c(1,nres+j)-xi
12874 ! yj=c(2,nres+j)-yi
12875 ! zj=c(3,nres+j)-zi
12876 ! Uncomment following three lines for Ca-p interactions
12880 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12882 sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
12884 if (sss.gt.0.0d0) then
12887 e1=fac*fac*aad(itypj,iteli)
12888 e2=fac*bad(itypj,iteli)
12889 if (iabs(j-i) .le. 2) then
12892 evdw2_14=evdw2_14+(e1+e2)*sss
12895 evdw2=evdw2+evdwij*sss
12896 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
12897 'evdw2',i,j,sss,evdwij
12899 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
12901 fac=-(evdwij+e1)*rrij*sss
12905 ! Uncomment following three lines for SC-p interactions
12907 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
12909 ! Uncomment following line for SC-p interactions
12910 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
12912 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
12913 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
12922 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
12923 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
12924 gradx_scp(j,i)=expon*gradx_scp(j,i)
12927 !******************************************************************************
12931 ! To save time the factor EXPON has been extracted from ALL components
12932 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12935 !******************************************************************************
12937 end subroutine escp_short
12938 !-----------------------------------------------------------------------------
12939 ! energy_p_new-sep_barrier.F
12940 !-----------------------------------------------------------------------------
12941 subroutine sc_grad_scale(scalfac)
12942 ! implicit real*8 (a-h,o-z)
12944 ! include 'DIMENSIONS'
12945 ! include 'COMMON.CHAIN'
12946 ! include 'COMMON.DERIV'
12947 ! include 'COMMON.CALC'
12948 ! include 'COMMON.IOUNITS'
12949 real(kind=8),dimension(3) :: dcosom1,dcosom2
12950 real(kind=8) :: scalfac
12951 !el local variables
12952 ! integer :: i,j,k,l
12954 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
12955 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
12956 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
12957 -2.0D0*alf12*eps3der+sigder*sigsq_om12
12961 ! eom12=evdwij*eps1_om12
12963 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
12964 ! & " sigder",sigder
12965 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
12966 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
12968 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
12969 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
12972 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac
12974 ! write (iout,*) "gg",(gg(k),k=1,3)
12976 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
12977 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
12978 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac
12979 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
12980 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
12981 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac
12982 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
12983 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
12984 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
12985 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
12988 ! Calculate the components of the gradient in DC and X
12991 gvdwc(l,i)=gvdwc(l,i)-gg(l)
12992 gvdwc(l,j)=gvdwc(l,j)+gg(l)
12995 end subroutine sc_grad_scale
12996 !-----------------------------------------------------------------------------
12997 ! energy_split-sep.F
12998 !-----------------------------------------------------------------------------
12999 subroutine etotal_long(energia)
13001 ! Compute the long-range slow-varying contributions to the energy
13003 ! implicit real*8 (a-h,o-z)
13004 ! include 'DIMENSIONS'
13005 use MD_data, only: totT
13009 !MS$ATTRIBUTES C :: proc_proc
13014 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
13016 ! include 'COMMON.SETUP'
13017 ! include 'COMMON.IOUNITS'
13018 ! include 'COMMON.FFIELD'
13019 ! include 'COMMON.DERIV'
13020 ! include 'COMMON.INTERACT'
13021 ! include 'COMMON.SBRIDGE'
13022 ! include 'COMMON.CHAIN'
13023 ! include 'COMMON.VAR'
13024 ! include 'COMMON.LOCAL'
13025 ! include 'COMMON.MD'
13026 real(kind=8),dimension(0:n_ene) :: energia
13027 !el local variables
13028 integer :: i,n_corr,n_corr1,ierror,ierr
13029 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
13030 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
13031 ecorr,ecorr5,ecorr6,eturn6,time00
13032 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
13033 !elwrite(iout,*)"in etotal long"
13035 if (modecalc.eq.12.or.modecalc.eq.14) then
13037 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
13039 call int_from_cart1(.false.)
13042 !elwrite(iout,*)"in etotal long"
13045 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
13046 ! & " absolute rank",myrank," nfgtasks",nfgtasks
13048 if (nfgtasks.gt.1) then
13050 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
13051 if (fg_rank.eq.0) then
13052 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
13053 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
13055 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
13056 ! FG slaves as WEIGHTS array.
13063 weights_(7)=wel_loc
13066 weights_(10)=wturn6
13068 weights_(12)=wscloc
13070 weights_(14)=wtor_d
13071 weights_(15)=wstrain
13072 weights_(16)=wvdwpp
13074 weights_(18)=scal14
13075 weights_(21)=wsccor
13076 ! FG Master broadcasts the WEIGHTS_ array
13077 call MPI_Bcast(weights_(1),n_ene,&
13078 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13080 ! FG slaves receive the WEIGHTS array
13081 call MPI_Bcast(weights(1),n_ene,&
13082 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13097 wstrain=weights(15)
13103 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
13105 time_Bcast=time_Bcast+MPI_Wtime()-time00
13106 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
13107 ! call chainbuild_cart
13108 ! call int_from_cart1(.false.)
13110 ! write (iout,*) 'Processor',myrank,
13111 ! & ' calling etotal_short ipot=',ipot
13113 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
13115 !d print *,'nnt=',nnt,' nct=',nct
13117 !elwrite(iout,*)"in etotal long"
13118 ! Compute the side-chain and electrostatic interaction energy
13120 goto (101,102,103,104,105,106) ipot
13121 ! Lennard-Jones potential.
13122 101 call elj_long(evdw)
13123 !d print '(a)','Exit ELJ'
13125 ! Lennard-Jones-Kihara potential (shifted).
13126 102 call eljk_long(evdw)
13128 ! Berne-Pechukas potential (dilated LJ, angular dependence).
13129 103 call ebp_long(evdw)
13131 ! Gay-Berne potential (shifted LJ, angular dependence).
13132 104 call egb_long(evdw)
13134 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
13135 105 call egbv_long(evdw)
13137 ! Soft-sphere potential
13138 106 call e_softsphere(evdw)
13140 ! Calculate electrostatic (H-bonding) energy of the main chain.
13144 if (ipot.lt.6) then
13146 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
13147 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
13148 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
13149 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
13151 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
13152 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
13153 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
13154 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
13156 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13165 ! write (iout,*) "Soft-spheer ELEC potential"
13166 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
13170 ! Calculate excluded-volume interaction energy between peptide groups
13173 if (ipot.lt.6) then
13174 if(wscp.gt.0d0) then
13175 call escp_long(evdw2,evdw2_14)
13181 call escp_soft_sphere(evdw2,evdw2_14)
13184 ! 12/1/95 Multi-body terms
13188 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
13189 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
13190 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
13191 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
13192 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
13199 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
13200 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
13203 ! If performing constraint dynamics, call the constraint energy
13204 ! after the equilibration time
13205 if(usampl.and.totT.gt.eq_time) then
13220 energia(2)=evdw2-evdw2_14
13221 energia(18)=evdw2_14
13230 energia(3)=ees+evdw1
13237 energia(8)=eello_turn3
13238 energia(9)=eello_turn4
13240 energia(20)=Uconst+Uconst_back
13241 call sum_energy(energia,.true.)
13242 ! write (iout,*) "Exit ETOTAL_LONG"
13245 end subroutine etotal_long
13246 !-----------------------------------------------------------------------------
13247 subroutine etotal_short(energia)
13249 ! Compute the short-range fast-varying contributions to the energy
13251 ! implicit real*8 (a-h,o-z)
13252 ! include 'DIMENSIONS'
13256 !MS$ATTRIBUTES C :: proc_proc
13261 integer :: ierror,ierr
13262 real(kind=8),dimension(n_ene) :: weights_
13263 real(kind=8) :: time00
13265 ! include 'COMMON.SETUP'
13266 ! include 'COMMON.IOUNITS'
13267 ! include 'COMMON.FFIELD'
13268 ! include 'COMMON.DERIV'
13269 ! include 'COMMON.INTERACT'
13270 ! include 'COMMON.SBRIDGE'
13271 ! include 'COMMON.CHAIN'
13272 ! include 'COMMON.VAR'
13273 ! include 'COMMON.LOCAL'
13274 real(kind=8),dimension(0:n_ene) :: energia
13275 !el local variables
13277 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
13278 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr
13281 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
13283 if (modecalc.eq.12.or.modecalc.eq.14) then
13285 if (fg_rank.eq.0) call int_from_cart1(.false.)
13287 call int_from_cart1(.false.)
13291 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
13292 ! & " absolute rank",myrank," nfgtasks",nfgtasks
13294 if (nfgtasks.gt.1) then
13296 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
13297 if (fg_rank.eq.0) then
13298 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
13299 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
13301 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
13302 ! FG slaves as WEIGHTS array.
13309 weights_(7)=wel_loc
13312 weights_(10)=wturn6
13314 weights_(12)=wscloc
13316 weights_(14)=wtor_d
13317 weights_(15)=wstrain
13318 weights_(16)=wvdwpp
13320 weights_(18)=scal14
13321 weights_(21)=wsccor
13322 ! FG Master broadcasts the WEIGHTS_ array
13323 call MPI_Bcast(weights_(1),n_ene,&
13324 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13326 ! FG slaves receive the WEIGHTS array
13327 call MPI_Bcast(weights(1),n_ene,&
13328 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13343 wstrain=weights(15)
13349 ! write (iout,*),"Processor",myrank," BROADCAST weights"
13350 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
13352 ! write (iout,*) "Processor",myrank," BROADCAST c"
13353 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
13355 ! write (iout,*) "Processor",myrank," BROADCAST dc"
13356 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
13358 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
13359 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
13361 ! write (iout,*) "Processor",myrank," BROADCAST theta"
13362 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
13364 ! write (iout,*) "Processor",myrank," BROADCAST phi"
13365 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
13367 ! write (iout,*) "Processor",myrank," BROADCAST alph"
13368 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
13370 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
13371 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
13373 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
13374 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
13376 time_Bcast=time_Bcast+MPI_Wtime()-time00
13377 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
13379 ! write (iout,*) 'Processor',myrank,
13380 ! & ' calling etotal_short ipot=',ipot
13382 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
13384 ! call int_from_cart1(.false.)
13386 ! Compute the side-chain and electrostatic interaction energy
13388 goto (101,102,103,104,105,106) ipot
13389 ! Lennard-Jones potential.
13390 101 call elj_short(evdw)
13391 !d print '(a)','Exit ELJ'
13393 ! Lennard-Jones-Kihara potential (shifted).
13394 102 call eljk_short(evdw)
13396 ! Berne-Pechukas potential (dilated LJ, angular dependence).
13397 103 call ebp_short(evdw)
13399 ! Gay-Berne potential (shifted LJ, angular dependence).
13400 104 call egb_short(evdw)
13402 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
13403 105 call egbv_short(evdw)
13405 ! Soft-sphere potential - already dealt with in the long-range part
13407 ! 106 call e_softsphere_short(evdw)
13409 ! Calculate electrostatic (H-bonding) energy of the main chain.
13413 ! Calculate the short-range part of Evdwpp
13415 call evdwpp_short(evdw1)
13417 ! Calculate the short-range part of ESCp
13419 if (ipot.lt.6) then
13420 call escp_short(evdw2,evdw2_14)
13423 ! Calculate the bond-stretching energy
13427 ! Calculate the disulfide-bridge and other energy and the contributions
13428 ! from other distance constraints.
13431 ! Calculate the virtual-bond-angle energy.
13435 ! Calculate the SC local energy.
13440 ! Calculate the virtual-bond torsional energy.
13442 call etor(etors,edihcnstr)
13444 ! 6/23/01 Calculate double-torsional energy
13446 call etor_d(etors_d)
13448 ! 21/5/07 Calculate local sicdechain correlation energy
13450 if (wsccor.gt.0.0d0) then
13451 call eback_sc_corr(esccor)
13456 ! Put energy components into an array
13463 energia(2)=evdw2-evdw2_14
13464 energia(18)=evdw2_14
13477 energia(14)=etors_d
13480 energia(19)=edihcnstr
13482 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
13484 call sum_energy(energia,.true.)
13485 ! write (iout,*) "Exit ETOTAL_SHORT"
13488 end subroutine etotal_short
13489 !-----------------------------------------------------------------------------
13491 !-----------------------------------------------------------------------------
13492 real(kind=8) function gnmr1(y,ymin,ymax)
13494 real(kind=8) :: y,ymin,ymax
13495 real(kind=8) :: wykl=4.0d0
13496 if (y.lt.ymin) then
13497 gnmr1=(ymin-y)**wykl/wykl
13498 else if (y.gt.ymax) then
13499 gnmr1=(y-ymax)**wykl/wykl
13505 !-----------------------------------------------------------------------------
13506 real(kind=8) function gnmr1prim(y,ymin,ymax)
13508 real(kind=8) :: y,ymin,ymax
13509 real(kind=8) :: wykl=4.0d0
13510 if (y.lt.ymin) then
13511 gnmr1prim=-(ymin-y)**(wykl-1)
13512 else if (y.gt.ymax) then
13513 gnmr1prim=(y-ymax)**(wykl-1)
13518 end function gnmr1prim
13519 !-----------------------------------------------------------------------------
13520 real(kind=8) function harmonic(y,ymax)
13522 real(kind=8) :: y,ymax
13523 real(kind=8) :: wykl=2.0d0
13524 harmonic=(y-ymax)**wykl
13526 end function harmonic
13527 !-----------------------------------------------------------------------------
13528 real(kind=8) function harmonicprim(y,ymax)
13529 real(kind=8) :: y,ymin,ymax
13530 real(kind=8) :: wykl=2.0d0
13531 harmonicprim=(y-ymax)*wykl
13533 end function harmonicprim
13534 !-----------------------------------------------------------------------------
13536 !-----------------------------------------------------------------------------
13537 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
13539 use io_base, only:intout,briefout
13540 ! implicit real*8 (a-h,o-z)
13541 ! include 'DIMENSIONS'
13542 ! include 'COMMON.CHAIN'
13543 ! include 'COMMON.DERIV'
13544 ! include 'COMMON.VAR'
13545 ! include 'COMMON.INTERACT'
13546 ! include 'COMMON.FFIELD'
13547 ! include 'COMMON.MD'
13548 ! include 'COMMON.IOUNITS'
13549 real(kind=8),external :: ufparm
13550 integer :: uiparm(1)
13551 real(kind=8) :: urparm(1)
13552 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
13553 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
13554 integer :: n,nf,ind,ind1,i,k,j
13556 ! This subroutine calculates total internal coordinate gradient.
13557 ! Depending on the number of function evaluations, either whole energy
13558 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
13559 ! internal coordinates are reevaluated or only the cartesian-in-internal
13560 ! coordinate derivatives are evaluated. The subroutine was designed to work
13566 !d print *,'grad',nf,icg
13567 if (nf-nfl+1) 20,30,40
13568 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
13569 ! write (iout,*) 'grad 20'
13570 if (nf.eq.0) return
13572 30 call var_to_geom(n,x)
13574 ! write (iout,*) 'grad 30'
13576 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
13579 ! write (iout,*) 'grad 40'
13580 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
13582 ! Convert the Cartesian gradient into internal-coordinate gradient.
13592 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
13594 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
13597 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
13603 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
13605 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
13606 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
13609 if (i.gt.1) g(i-1)=gphii
13610 if (n.gt.nphi) g(nphi+i)=gthetai
13612 if (n.le.nphi+ntheta) goto 10
13614 if (itype(i).ne.10) then
13618 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
13621 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
13623 g(ialph(i,1))=galphai
13624 g(ialph(i,1)+nside)=gomegai
13628 ! Add the components corresponding to local energy terms.
13632 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
13633 g(i)=g(i)+gloc(i,icg)
13635 ! Uncomment following three lines for diagnostics.
13637 !elwrite(iout,*) "in gradient after calling intout"
13638 !d call briefout(0,0.0d0)
13639 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
13641 end subroutine gradient
13642 !-----------------------------------------------------------------------------
13643 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
13646 ! implicit real*8 (a-h,o-z)
13647 ! include 'DIMENSIONS'
13648 ! include 'COMMON.DERIV'
13649 ! include 'COMMON.IOUNITS'
13650 ! include 'COMMON.GEO'
13653 !el common /chuju/ jjj
13654 real(kind=8) :: energia(0:n_ene)
13655 integer :: uiparm(1)
13656 real(kind=8) :: urparm(1)
13658 real(kind=8),external :: ufparm
13659 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
13660 ! if (jjj.gt.0) then
13661 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
13665 !d print *,'func',nf,nfl,icg
13666 call var_to_geom(n,x)
13669 !d write (iout,*) 'ETOTAL called from FUNC'
13670 call etotal(energia)
13673 ! if (jjj.gt.0) then
13674 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
13675 ! write (iout,*) 'f=',etot
13679 end subroutine func
13680 !-----------------------------------------------------------------------------
13681 subroutine cartgrad
13682 ! implicit real*8 (a-h,o-z)
13683 ! include 'DIMENSIONS'
13685 use MD_data, only: totT
13689 ! include 'COMMON.CHAIN'
13690 ! include 'COMMON.DERIV'
13691 ! include 'COMMON.VAR'
13692 ! include 'COMMON.INTERACT'
13693 ! include 'COMMON.FFIELD'
13694 ! include 'COMMON.MD'
13695 ! include 'COMMON.IOUNITS'
13696 ! include 'COMMON.TIME1'
13700 ! This subrouting calculates total Cartesian coordinate gradient.
13701 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
13713 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
13714 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
13717 ! If performing constraint dynamics, add the gradients of the constraint energy
13718 if(usampl.and.totT.gt.eq_time) then
13721 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
13722 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
13726 gloc(i,icg)=gloc(i,icg)+dugamma(i)
13729 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
13737 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
13739 ! call checkintcartgrad
13740 ! write(iout,*) 'calling int_to_cart'
13742 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
13746 gcart(j,i)=gradc(j,i,icg)
13747 gxcart(j,i)=gradx(j,i,icg)
13750 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
13751 (gxcart(j,i),j=1,3),gloc(i,icg)
13759 time_inttocart=time_inttocart+MPI_Wtime()-time01
13762 write (iout,*) "gcart and gxcart after int_to_cart"
13764 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
13765 (gxcart(j,i),j=1,3)
13769 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
13773 end subroutine cartgrad
13774 !-----------------------------------------------------------------------------
13775 subroutine zerograd
13776 ! implicit real*8 (a-h,o-z)
13777 ! include 'DIMENSIONS'
13778 ! include 'COMMON.DERIV'
13779 ! include 'COMMON.CHAIN'
13780 ! include 'COMMON.VAR'
13781 ! include 'COMMON.MD'
13782 ! include 'COMMON.SCCOR'
13784 !el local variables
13785 integer :: i,j,intertyp
13786 ! Initialize Cartesian-coordinate gradient
13788 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
13789 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
13791 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
13792 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
13793 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
13794 ! allocate(gradcorr_long(3,nres))
13795 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
13796 ! allocate(gcorr6_turn_long(3,nres))
13797 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
13799 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
13801 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
13802 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
13804 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
13805 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
13807 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
13808 ! allocate(gscloc(3,nres)) !(3,maxres)
13809 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
13813 ! common /deriv_scloc/
13814 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
13815 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
13816 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
13818 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
13822 ! gradc(j,i,icg)=0.0d0
13823 ! gradx(j,i,icg)=0.0d0
13825 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
13826 !elwrite(iout,*) "icg",icg
13830 gradx_scp(j,i)=0.0D0
13832 gvdwc_scp(j,i)=0.0D0
13833 gvdwc_scpp(j,i)=0.0d0
13835 gelc_long(j,i)=0.0D0
13840 gel_loc_long(j,i)=0.0d0
13843 gcorr3_turn(j,i)=0.0d0
13844 gcorr4_turn(j,i)=0.0d0
13845 gradcorr(j,i)=0.0d0
13846 gradcorr_long(j,i)=0.0d0
13847 gradcorr5_long(j,i)=0.0d0
13848 gradcorr6_long(j,i)=0.0d0
13849 gcorr6_turn_long(j,i)=0.0d0
13850 gradcorr5(j,i)=0.0d0
13851 gradcorr6(j,i)=0.0d0
13852 gcorr6_turn(j,i)=0.0d0
13855 gradc(j,i,icg)=0.0d0
13856 gradx(j,i,icg)=0.0d0
13860 gloc_sc(intertyp,i,icg)=0.0d0
13865 ! Initialize the gradient of local energy terms.
13867 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
13868 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
13869 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
13870 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
13871 ! allocate(gel_loc_turn3(nres))
13872 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
13873 ! allocate(gsccor_loc(nres)) !(maxres)
13879 gel_loc_loc(i)=0.0d0
13881 g_corr5_loc(i)=0.0d0
13882 g_corr6_loc(i)=0.0d0
13883 gel_loc_turn3(i)=0.0d0
13884 gel_loc_turn4(i)=0.0d0
13885 gel_loc_turn6(i)=0.0d0
13886 gsccor_loc(i)=0.0d0
13888 ! initialize gcart and gxcart
13889 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
13897 end subroutine zerograd
13898 !-----------------------------------------------------------------------------
13899 real(kind=8) function fdum()
13903 !-----------------------------------------------------------------------------
13905 !-----------------------------------------------------------------------------
13906 subroutine intcartderiv
13907 ! implicit real*8 (a-h,o-z)
13908 ! include 'DIMENSIONS'
13912 ! include 'COMMON.SETUP'
13913 ! include 'COMMON.CHAIN'
13914 ! include 'COMMON.VAR'
13915 ! include 'COMMON.GEO'
13916 ! include 'COMMON.INTERACT'
13917 ! include 'COMMON.DERIV'
13918 ! include 'COMMON.IOUNITS'
13919 ! include 'COMMON.LOCAL'
13920 ! include 'COMMON.SCCOR'
13921 real(kind=8) :: pi4,pi34
13922 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
13923 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
13924 dcosomega,dsinomega !(3,3,maxres)
13925 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
13928 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
13929 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
13930 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
13931 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
13935 !el from module energy-------------
13936 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
13937 !el allocate(dsintau(3,3,3,itau_start:itau_end))
13938 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
13940 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
13941 !el allocate(dsintau(3,3,3,0:nres2))
13942 !el allocate(dtauangle(3,3,3,0:nres2))
13943 !el allocate(domicron(3,2,2,0:nres2))
13944 !el allocate(dcosomicron(3,2,2,0:nres2))
13948 #if defined(MPI) && defined(PARINTDER)
13949 if (nfgtasks.gt.1 .and. me.eq.king) &
13950 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
13955 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
13956 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
13958 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
13961 dtheta(j,1,i)=0.0d0
13962 dtheta(j,2,i)=0.0d0
13968 ! Derivatives of theta's
13969 #if defined(MPI) && defined(PARINTDER)
13970 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
13971 do i=max0(ithet_start-1,3),ithet_end
13975 cost=dcos(theta(i))
13976 sint=sqrt(1-cost*cost)
13978 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
13980 if (itype(i-1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
13981 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
13983 if (itype(i-1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
13986 #if defined(MPI) && defined(PARINTDER)
13987 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
13988 do i=max0(ithet_start-1,3),ithet_end
13992 if ((itype(i-1).ne.10).and.(itype(i-1).ne.ntyp1)) then
13993 cost1=dcos(omicron(1,i))
13994 sint1=sqrt(1-cost1*cost1)
13995 cost2=dcos(omicron(2,i))
13996 sint2=sqrt(1-cost2*cost2)
13998 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
13999 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
14000 cost1*dc_norm(j,i-2))/ &
14002 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
14003 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
14004 +cost1*(dc_norm(j,i-1+nres)))/ &
14006 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
14007 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
14008 !C Looks messy but better than if in loop
14009 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
14010 +cost2*dc_norm(j,i-1))/ &
14012 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
14013 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
14014 +cost2*(-dc_norm(j,i-1+nres)))/ &
14016 ! write(iout,*) "vbld", i,itype(i),vbld(i-1+nres)
14017 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
14021 !elwrite(iout,*) "after vbld write"
14022 ! Derivatives of phi:
14023 ! If phi is 0 or 180 degrees, then the formulas
14024 ! have to be derived by power series expansion of the
14025 ! conventional formulas around 0 and 180.
14027 do i=iphi1_start,iphi1_end
14031 ! if (itype(i-1).eq.21 .or. itype(i-2).eq.21 ) cycle
14032 ! the conventional case
14033 sint=dsin(theta(i))
14034 sint1=dsin(theta(i-1))
14036 cost=dcos(theta(i))
14037 cost1=dcos(theta(i-1))
14039 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
14040 fac0=1.0d0/(sint1*sint)
14043 fac3=cosg*cost1/(sint1*sint1)
14044 fac4=cosg*cost/(sint*sint)
14045 ! Obtaining the gamma derivatives from sine derivative
14046 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
14047 phi(i).gt.pi34.and.phi(i).le.pi.or. &
14048 phi(i).gt.-pi.and.phi(i).le.-pi34) then
14049 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
14050 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
14051 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
14055 cosg_inv=1.0d0/cosg
14056 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
14057 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
14058 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
14059 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
14061 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
14062 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14063 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
14064 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
14065 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
14066 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14067 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
14069 ! Bug fixed 3/24/05 (AL)
14071 ! Obtaining the gamma derivatives from cosine derivative
14074 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
14075 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
14076 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
14077 dc_norm(j,i-3))/vbld(i-2)
14078 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
14079 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
14080 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
14082 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
14083 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
14084 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
14085 dc_norm(j,i-1))/vbld(i)
14086 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
14091 !alculate derivative of Tauangle
14093 do i=itau_start,itau_end
14096 !elwrite(iout,*) " vecpr",i,nres
14098 if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
14099 ! if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10).or.
14100 ! & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1)) cycle
14101 !c dtauangle(j,intertyp,dervityp,residue number)
14102 !c INTERTYP=1 SC...Ca...Ca..Ca
14103 ! the conventional case
14104 sint=dsin(theta(i))
14105 sint1=dsin(omicron(2,i-1))
14106 sing=dsin(tauangle(1,i))
14107 cost=dcos(theta(i))
14108 cost1=dcos(omicron(2,i-1))
14109 cosg=dcos(tauangle(1,i))
14111 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
14112 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
14114 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
14115 fac0=1.0d0/(sint1*sint)
14118 fac3=cosg*cost1/(sint1*sint1)
14119 fac4=cosg*cost/(sint*sint)
14120 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
14121 ! Obtaining the gamma derivatives from sine derivative
14122 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
14123 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
14124 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
14125 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
14126 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
14127 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
14131 cosg_inv=1.0d0/cosg
14132 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
14133 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
14134 *vbld_inv(i-2+nres)
14135 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
14136 dsintau(j,1,2,i)= &
14137 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
14138 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14139 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
14140 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
14141 ! Bug fixed 3/24/05 (AL)
14142 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
14143 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
14144 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14145 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
14147 ! Obtaining the gamma derivatives from cosine derivative
14150 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
14151 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
14152 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
14153 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
14154 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
14155 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
14157 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
14158 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
14159 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
14160 dc_norm(j,i-1))/vbld(i)
14161 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
14162 ! write (iout,*) "else",i
14166 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
14169 !C Second case Ca...Ca...Ca...SC
14171 do i=itau_start,itau_end
14175 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
14176 (itype(i-2).eq.ntyp1).or.(itype(i-3).eq.ntyp1)) cycle
14177 ! the conventional case
14178 sint=dsin(omicron(1,i))
14179 sint1=dsin(theta(i-1))
14180 sing=dsin(tauangle(2,i))
14181 cost=dcos(omicron(1,i))
14182 cost1=dcos(theta(i-1))
14183 cosg=dcos(tauangle(2,i))
14185 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
14187 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
14188 fac0=1.0d0/(sint1*sint)
14191 fac3=cosg*cost1/(sint1*sint1)
14192 fac4=cosg*cost/(sint*sint)
14193 ! Obtaining the gamma derivatives from sine derivative
14194 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
14195 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
14196 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
14197 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
14198 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
14199 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
14203 cosg_inv=1.0d0/cosg
14204 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
14205 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
14206 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
14207 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
14208 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
14209 dsintau(j,2,2,i)= &
14210 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
14211 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14212 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
14213 ! & sing*ctgt*domicron(j,1,2,i),
14214 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14215 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
14216 ! Bug fixed 3/24/05 (AL)
14217 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
14218 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
14219 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14220 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
14222 ! Obtaining the gamma derivatives from cosine derivative
14225 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
14226 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
14227 dc_norm(j,i-3))/vbld(i-2)
14228 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
14229 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
14230 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
14231 dcosomicron(j,1,1,i)
14232 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
14233 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
14234 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
14235 dc_norm(j,i-1+nres))/vbld(i-1+nres)
14236 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
14237 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
14242 !CC third case SC...Ca...Ca...SC
14245 do i=itau_start,itau_end
14249 ! the conventional case
14250 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
14251 (itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
14252 sint=dsin(omicron(1,i))
14253 sint1=dsin(omicron(2,i-1))
14254 sing=dsin(tauangle(3,i))
14255 cost=dcos(omicron(1,i))
14256 cost1=dcos(omicron(2,i-1))
14257 cosg=dcos(tauangle(3,i))
14259 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
14260 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
14262 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
14263 fac0=1.0d0/(sint1*sint)
14266 fac3=cosg*cost1/(sint1*sint1)
14267 fac4=cosg*cost/(sint*sint)
14268 ! Obtaining the gamma derivatives from sine derivative
14269 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
14270 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
14271 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
14272 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
14273 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
14274 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
14278 cosg_inv=1.0d0/cosg
14279 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
14280 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
14281 *vbld_inv(i-2+nres)
14282 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
14283 dsintau(j,3,2,i)= &
14284 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
14285 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14286 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
14287 ! Bug fixed 3/24/05 (AL)
14288 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
14289 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
14290 *vbld_inv(i-1+nres)
14291 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14292 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
14294 ! Obtaining the gamma derivatives from cosine derivative
14297 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
14298 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
14299 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
14300 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
14301 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
14302 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
14303 dcosomicron(j,1,1,i)
14304 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
14305 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
14306 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
14307 dc_norm(j,i-1+nres))/vbld(i-1+nres)
14308 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
14309 ! write(iout,*) "else",i
14315 ! Derivatives of side-chain angles alpha and omega
14316 #if defined(MPI) && defined(PARINTDER)
14317 do i=ibond_start,ibond_end
14321 if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then
14322 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
14325 fac8=fac5/vbld(i+1)
14326 fac9=fac5/vbld(i+nres)
14327 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
14328 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
14329 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
14330 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
14331 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
14332 sina=sqrt(1-cosa*cosa)
14334 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
14336 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
14337 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
14338 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
14339 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
14340 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
14341 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
14342 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
14343 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
14345 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
14347 ! obtaining the derivatives of omega from sines
14348 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
14349 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
14350 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
14351 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
14353 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
14354 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
14355 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
14356 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
14357 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
14358 coso_inv=1.0d0/dcos(omeg(i))
14360 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
14361 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
14362 (sino*dc_norm(j,i-1))/vbld(i)
14363 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
14364 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
14365 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
14366 -sino*dc_norm(j,i)/vbld(i+1)
14367 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
14368 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
14369 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
14371 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
14374 ! obtaining the derivatives of omega from cosines
14375 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
14376 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
14381 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
14382 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
14383 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
14384 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
14385 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
14386 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
14387 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
14388 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
14389 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
14390 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
14391 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
14392 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
14393 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
14394 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
14395 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
14401 dalpha(k,j,i)=0.0d0
14402 domega(k,j,i)=0.0d0
14408 #if defined(MPI) && defined(PARINTDER)
14409 if (nfgtasks.gt.1) then
14411 !d write (iout,*) "Gather dtheta"
14412 !d call flush(iout)
14413 write (iout,*) "dtheta before gather"
14415 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
14418 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
14419 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
14420 king,FG_COMM,IERROR)
14422 !d write (iout,*) "Gather dphi"
14423 !d call flush(iout)
14424 write (iout,*) "dphi before gather"
14426 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
14429 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
14430 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
14431 king,FG_COMM,IERROR)
14432 !d write (iout,*) "Gather dalpha"
14433 !d call flush(iout)
14435 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
14436 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
14437 king,FG_COMM,IERROR)
14438 !d write (iout,*) "Gather domega"
14439 !d call flush(iout)
14440 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
14441 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
14442 king,FG_COMM,IERROR)
14447 write (iout,*) "dtheta after gather"
14449 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
14451 write (iout,*) "dphi after gather"
14453 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
14455 write (iout,*) "dalpha after gather"
14457 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
14459 write (iout,*) "domega after gather"
14461 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
14465 end subroutine intcartderiv
14466 !-----------------------------------------------------------------------------
14467 subroutine checkintcartgrad
14468 ! implicit real*8 (a-h,o-z)
14469 ! include 'DIMENSIONS'
14473 ! include 'COMMON.CHAIN'
14474 ! include 'COMMON.VAR'
14475 ! include 'COMMON.GEO'
14476 ! include 'COMMON.INTERACT'
14477 ! include 'COMMON.DERIV'
14478 ! include 'COMMON.IOUNITS'
14479 ! include 'COMMON.SETUP'
14480 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
14481 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
14482 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
14483 real(kind=8),dimension(3) :: dc_norm_s
14484 real(kind=8) :: aincr=1.0d-5
14486 real(kind=8) :: dcji
14489 theta_s(i)=theta(i)
14493 ! Check theta gradient
14495 "Analytical (upper) and numerical (lower) gradient of theta"
14500 dc(j,i-2)=dcji+aincr
14501 call chainbuild_cart
14502 call int_from_cart1(.false.)
14503 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
14506 dc(j,i-1)=dc(j,i-1)+aincr
14507 call chainbuild_cart
14508 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
14511 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
14512 !el (dtheta(j,2,i),j=1,3)
14513 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
14514 !el (dthetanum(j,2,i),j=1,3)
14515 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
14516 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
14517 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
14520 ! Check gamma gradient
14522 "Analytical (upper) and numerical (lower) gradient of gamma"
14526 dc(j,i-3)=dcji+aincr
14527 call chainbuild_cart
14528 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
14531 dc(j,i-2)=dcji+aincr
14532 call chainbuild_cart
14533 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
14536 dc(j,i-1)=dc(j,i-1)+aincr
14537 call chainbuild_cart
14538 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
14541 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
14542 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
14543 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
14544 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
14545 !el write (iout,'(5x,3(3f10.5,5x))') &
14546 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
14547 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
14548 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
14551 ! Check alpha gradient
14553 "Analytical (upper) and numerical (lower) gradient of alpha"
14555 if(itype(i).ne.10) then
14558 dc(j,i-1)=dcji+aincr
14559 call chainbuild_cart
14560 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
14565 call chainbuild_cart
14566 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
14570 dc(j,i+nres)=dc(j,i+nres)+aincr
14571 call chainbuild_cart
14572 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
14577 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
14578 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
14579 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
14580 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
14581 !el write (iout,'(5x,3(3f10.5,5x))') &
14582 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
14583 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
14584 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
14587 ! Check omega gradient
14589 "Analytical (upper) and numerical (lower) gradient of omega"
14591 if(itype(i).ne.10) then
14594 dc(j,i-1)=dcji+aincr
14595 call chainbuild_cart
14596 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
14601 call chainbuild_cart
14602 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
14606 dc(j,i+nres)=dc(j,i+nres)+aincr
14607 call chainbuild_cart
14608 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
14613 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
14614 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
14615 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
14616 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
14617 !el write (iout,'(5x,3(3f10.5,5x))') &
14618 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
14619 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
14620 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
14624 end subroutine checkintcartgrad
14625 !-----------------------------------------------------------------------------
14627 !-----------------------------------------------------------------------------
14628 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
14629 ! implicit real*8 (a-h,o-z)
14630 ! include 'DIMENSIONS'
14631 ! include 'COMMON.IOUNITS'
14632 ! include 'COMMON.CHAIN'
14633 ! include 'COMMON.INTERACT'
14634 ! include 'COMMON.VAR'
14635 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
14636 integer :: kkk,nsep=3
14637 real(kind=8) :: qm !dist,
14638 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
14639 logical :: lprn=.false.
14641 ! real(kind=8) :: sigm,x
14643 !el sigm(x)=0.25d0*x ! local function
14649 do il=seg1+nsep,seg2
14652 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
14653 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
14654 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
14656 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
14657 if (itype(il).ne.10 .or. itype(jl).ne.10) then
14660 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
14661 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
14662 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
14663 dijCM=dist(il+nres,jl+nres)
14664 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
14666 qq = qq+qqij+qqijCM
14672 if((seg3-il).lt.3) then
14679 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
14680 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
14681 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
14683 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
14684 if (itype(il).ne.10 .or. itype(jl).ne.10) then
14687 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
14688 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
14689 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
14690 dijCM=dist(il+nres,jl+nres)
14691 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
14693 qq = qq+qqij+qqijCM
14698 if (qqmax.le.qq) qqmax=qq
14700 qwolynes=1.0d0-qqmax
14702 end function qwolynes
14703 !-----------------------------------------------------------------------------
14704 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
14705 ! implicit real*8 (a-h,o-z)
14706 ! include 'DIMENSIONS'
14707 ! include 'COMMON.IOUNITS'
14708 ! include 'COMMON.CHAIN'
14709 ! include 'COMMON.INTERACT'
14710 ! include 'COMMON.VAR'
14711 ! include 'COMMON.MD'
14712 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
14713 integer :: nsep=3, kkk
14714 !el real(kind=8) :: dist
14715 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
14716 logical :: lprn=.false.
14718 real(kind=8) :: sim,dd0,fac,ddqij
14719 !el sigm(x)=0.25d0*x ! local function
14729 do il=seg1+nsep,seg2
14732 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
14733 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
14734 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
14736 sim = 1.0d0/sigm(d0ij)
14739 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
14741 ddqij = (c(k,il)-c(k,jl))*fac
14742 dqwol(k,il)=dqwol(k,il)+ddqij
14743 dqwol(k,jl)=dqwol(k,jl)-ddqij
14746 if (itype(il).ne.10 .or. itype(jl).ne.10) then
14749 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
14750 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
14751 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
14752 dijCM=dist(il+nres,jl+nres)
14753 sim = 1.0d0/sigm(d0ijCM)
14756 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
14758 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
14759 dxqwol(k,il)=dxqwol(k,il)+ddqij
14760 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
14767 if((seg3-il).lt.3) then
14774 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
14775 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
14776 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
14778 sim = 1.0d0/sigm(d0ij)
14781 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
14783 ddqij = (c(k,il)-c(k,jl))*fac
14784 dqwol(k,il)=dqwol(k,il)+ddqij
14785 dqwol(k,jl)=dqwol(k,jl)-ddqij
14787 if (itype(il).ne.10 .or. itype(jl).ne.10) then
14790 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
14791 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
14792 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
14793 dijCM=dist(il+nres,jl+nres)
14794 sim = 1.0d0/sigm(d0ijCM)
14797 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
14799 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
14800 dxqwol(k,il)=dxqwol(k,il)+ddqij
14801 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
14810 dqwol(j,i)=dqwol(j,i)/nl
14811 dxqwol(j,i)=dxqwol(j,i)/nl
14815 end subroutine qwolynes_prim
14816 !-----------------------------------------------------------------------------
14817 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
14818 ! implicit real*8 (a-h,o-z)
14819 ! include 'DIMENSIONS'
14820 ! include 'COMMON.IOUNITS'
14821 ! include 'COMMON.CHAIN'
14822 ! include 'COMMON.INTERACT'
14823 ! include 'COMMON.VAR'
14824 integer :: seg1,seg2,seg3,seg4
14826 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
14827 real(kind=8),dimension(3,0:2*nres) :: cdummy
14828 real(kind=8) :: q1,q2
14829 real(kind=8) :: delta=1.0d-10
14834 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
14836 c(j,i)=c(j,i)+delta
14837 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
14838 qwolan(j,i)=(q2-q1)/delta
14844 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
14845 cdummy(j,i+nres)=c(j,i+nres)
14846 c(j,i+nres)=c(j,i+nres)+delta
14847 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
14848 qwolxan(j,i)=(q2-q1)/delta
14849 c(j,i+nres)=cdummy(j,i+nres)
14852 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
14854 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
14856 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
14858 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
14861 end subroutine qwol_num
14862 !-----------------------------------------------------------------------------
14863 subroutine EconstrQ
14864 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
14865 ! implicit real*8 (a-h,o-z)
14866 ! include 'DIMENSIONS'
14867 ! include 'COMMON.CONTROL'
14868 ! include 'COMMON.VAR'
14869 ! include 'COMMON.MD'
14872 ! include 'COMMON.LANGEVIN'
14874 ! include 'COMMON.LANGEVIN.lang0'
14876 ! include 'COMMON.CHAIN'
14877 ! include 'COMMON.DERIV'
14878 ! include 'COMMON.GEO'
14879 ! include 'COMMON.LOCAL'
14880 ! include 'COMMON.INTERACT'
14881 ! include 'COMMON.IOUNITS'
14882 ! include 'COMMON.NAMES'
14883 ! include 'COMMON.TIME1'
14884 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
14885 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
14887 integer :: kstart,kend,lstart,lend,idummy
14888 real(kind=8) :: delta=1.0d-7
14889 integer :: i,j,k,ii
14893 dudconst(j,i)=0.0d0
14894 duxconst(j,i)=0.0d0
14895 dudxconst(j,i)=0.0d0
14900 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
14902 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
14903 ! Calculating the derivatives of Constraint energy with respect to Q
14904 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
14906 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
14907 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
14908 ! hmnum=(hm2-hm1)/delta
14909 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
14910 ! & qinfrag(i,iset))
14911 ! write(iout,*) "harmonicnum frag", hmnum
14912 ! Calculating the derivatives of Q with respect to cartesian coordinates
14913 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
14915 ! write(iout,*) "dqwol "
14917 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
14919 ! write(iout,*) "dxqwol "
14921 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
14923 ! Calculating numerical gradients of dU/dQi and dQi/dxi
14924 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
14925 ! & ,idummy,idummy)
14926 ! The gradients of Uconst in Cs
14929 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
14930 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
14935 kstart=ifrag(1,ipair(1,i,iset),iset)
14936 kend=ifrag(2,ipair(1,i,iset),iset)
14937 lstart=ifrag(1,ipair(2,i,iset),iset)
14938 lend=ifrag(2,ipair(2,i,iset),iset)
14939 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
14940 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
14941 ! Calculating dU/dQ
14942 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
14943 ! hm1=harmonic(qpair(i),qinpair(i,iset))
14944 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
14945 ! hmnum=(hm2-hm1)/delta
14946 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
14947 ! & qinpair(i,iset))
14948 ! write(iout,*) "harmonicnum pair ", hmnum
14949 ! Calculating dQ/dXi
14950 call qwolynes_prim(kstart,kend,.false.,&
14952 ! write(iout,*) "dqwol "
14954 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
14956 ! write(iout,*) "dxqwol "
14958 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
14960 ! Calculating numerical gradients
14961 ! call qwol_num(kstart,kend,.false.
14963 ! The gradients of Uconst in Cs
14966 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
14967 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
14971 ! write(iout,*) "Uconst inside subroutine ", Uconst
14972 ! Transforming the gradients from Cs to dCs for the backbone
14976 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
14980 ! Transforming the gradients from Cs to dCs for the side chains
14983 dudxconst(j,i)=duxconst(j,i)
14986 ! write(iout,*) "dU/ddc backbone "
14988 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
14990 ! write(iout,*) "dU/ddX side chain "
14992 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
14994 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
14995 ! call dEconstrQ_num
14997 end subroutine EconstrQ
14998 !-----------------------------------------------------------------------------
14999 subroutine dEconstrQ_num
15000 ! Calculating numerical dUconst/ddc and dUconst/ddx
15001 ! implicit real*8 (a-h,o-z)
15002 ! include 'DIMENSIONS'
15003 ! include 'COMMON.CONTROL'
15004 ! include 'COMMON.VAR'
15005 ! include 'COMMON.MD'
15008 ! include 'COMMON.LANGEVIN'
15010 ! include 'COMMON.LANGEVIN.lang0'
15012 ! include 'COMMON.CHAIN'
15013 ! include 'COMMON.DERIV'
15014 ! include 'COMMON.GEO'
15015 ! include 'COMMON.LOCAL'
15016 ! include 'COMMON.INTERACT'
15017 ! include 'COMMON.IOUNITS'
15018 ! include 'COMMON.NAMES'
15019 ! include 'COMMON.TIME1'
15020 real(kind=8) :: uzap1,uzap2
15021 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
15022 integer :: kstart,kend,lstart,lend,idummy
15023 real(kind=8) :: delta=1.0d-7
15024 !el local variables
15030 dUcartan(j,i)=0.0d0
15031 cdummy(j,i)=dc(j,i)
15032 dc(j,i)=dc(j,i)+delta
15033 call chainbuild_cart
15036 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15038 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
15042 kstart=ifrag(1,ipair(1,ii,iset),iset)
15043 kend=ifrag(2,ipair(1,ii,iset),iset)
15044 lstart=ifrag(1,ipair(2,ii,iset),iset)
15045 lend=ifrag(2,ipair(2,ii,iset),iset)
15046 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15047 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
15050 dc(j,i)=cdummy(j,i)
15051 call chainbuild_cart
15054 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15056 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
15060 kstart=ifrag(1,ipair(1,ii,iset),iset)
15061 kend=ifrag(2,ipair(1,ii,iset),iset)
15062 lstart=ifrag(1,ipair(2,ii,iset),iset)
15063 lend=ifrag(2,ipair(2,ii,iset),iset)
15064 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15065 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
15068 ducartan(j,i)=(uzap2-uzap1)/(delta)
15071 ! Calculating numerical gradients for dU/ddx
15073 duxcartan(j,i)=0.0d0
15075 cdummy(j,i)=dc(j,i+nres)
15076 dc(j,i+nres)=dc(j,i+nres)+delta
15077 call chainbuild_cart
15080 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15082 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
15086 kstart=ifrag(1,ipair(1,ii,iset),iset)
15087 kend=ifrag(2,ipair(1,ii,iset),iset)
15088 lstart=ifrag(1,ipair(2,ii,iset),iset)
15089 lend=ifrag(2,ipair(2,ii,iset),iset)
15090 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15091 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
15094 dc(j,i+nres)=cdummy(j,i)
15095 call chainbuild_cart
15098 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
15099 ifrag(2,ii,iset),.true.,idummy,idummy)
15100 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
15104 kstart=ifrag(1,ipair(1,ii,iset),iset)
15105 kend=ifrag(2,ipair(1,ii,iset),iset)
15106 lstart=ifrag(1,ipair(2,ii,iset),iset)
15107 lend=ifrag(2,ipair(2,ii,iset),iset)
15108 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15109 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
15112 duxcartan(j,i)=(uzap2-uzap1)/(delta)
15115 write(iout,*) "Numerical dUconst/ddc backbone "
15117 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
15119 ! write(iout,*) "Numerical dUconst/ddx side-chain "
15121 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
15124 end subroutine dEconstrQ_num
15125 !-----------------------------------------------------------------------------
15127 !-----------------------------------------------------------------------------
15128 subroutine check_energies
15130 ! use random, only: ran_number
15134 ! include 'DIMENSIONS'
15135 ! include 'COMMON.CHAIN'
15136 ! include 'COMMON.VAR'
15137 ! include 'COMMON.IOUNITS'
15138 ! include 'COMMON.SBRIDGE'
15139 ! include 'COMMON.LOCAL'
15140 ! include 'COMMON.GEO'
15142 ! External functions
15143 !EL double precision ran_number
15144 !EL external ran_number
15147 integer :: i,j,k,l,lmax,p,pmax
15148 real(kind=8) :: rmin,rmax
15149 real(kind=8) :: eij
15152 real(kind=8) :: wi,rij,tj,pj
15174 !t wi=ran_number(0.0D0,pi)
15175 ! wi=ran_number(0.0D0,pi/6.0D0)
15177 !t tj=ran_number(0.0D0,pi)
15178 !t pj=ran_number(0.0D0,pi)
15179 ! pj=ran_number(0.0D0,pi/6.0D0)
15183 !t rij=ran_number(rmin,rmax)
15185 c(1,j)=d*sin(pj)*cos(tj)
15186 c(2,j)=d*sin(pj)*sin(tj)
15192 c(3,i)=-rij-d*cos(wi)
15195 dc(k,nres+i)=c(k,nres+i)-c(k,i)
15196 dc_norm(k,nres+i)=dc(k,nres+i)/d
15197 dc(k,nres+j)=c(k,nres+j)-c(k,j)
15198 dc_norm(k,nres+j)=dc(k,nres+j)/d
15201 call dyn_ssbond_ene(i,j,eij)
15206 end subroutine check_energies
15207 !-----------------------------------------------------------------------------
15208 subroutine dyn_ssbond_ene(resi,resj,eij)
15213 ! include 'DIMENSIONS'
15214 ! include 'COMMON.SBRIDGE'
15215 ! include 'COMMON.CHAIN'
15216 ! include 'COMMON.DERIV'
15217 ! include 'COMMON.LOCAL'
15218 ! include 'COMMON.INTERACT'
15219 ! include 'COMMON.VAR'
15220 ! include 'COMMON.IOUNITS'
15221 ! include 'COMMON.CALC'
15225 ! include 'COMMON.MD'
15226 ! use MD, only: totT,t_bath
15229 ! External functions
15230 !EL double precision h_base
15231 !EL external h_base
15234 integer :: resi,resj
15237 real(kind=8) :: eij
15240 logical :: havebond
15241 integer itypi,itypj
15242 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
15243 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
15244 real(kind=8),dimension(3) :: dcosom1,dcosom2
15246 real(kind=8) :: pom1,pom2
15247 real(kind=8) :: ljA,ljB,ljXs
15248 real(kind=8),dimension(1:3) :: d_ljB
15249 real(kind=8) :: ssA,ssB,ssC,ssXs
15250 real(kind=8) :: ssxm,ljxm,ssm,ljm
15251 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
15252 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
15253 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
15254 !-------FIRST METHOD
15256 real(kind=8),dimension(1:3) :: d_xm
15257 !-------END FIRST METHOD
15258 !-------SECOND METHOD
15259 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
15260 !-------END SECOND METHOD
15262 !-------TESTING CODE
15263 !el logical :: checkstop,transgrad
15264 !el common /sschecks/ checkstop,transgrad
15266 integer :: icheck,nicheck,jcheck,njcheck
15267 real(kind=8),dimension(-1:1) :: echeck
15268 real(kind=8) :: deps,ssx0,ljx0
15269 !-------END TESTING CODE
15274 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
15275 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
15278 dxi=dc_norm(1,nres+i)
15279 dyi=dc_norm(2,nres+i)
15280 dzi=dc_norm(3,nres+i)
15281 dsci_inv=vbld_inv(i+nres)
15284 xj=c(1,nres+j)-c(1,nres+i)
15285 yj=c(2,nres+j)-c(2,nres+i)
15286 zj=c(3,nres+j)-c(3,nres+i)
15287 dxj=dc_norm(1,nres+j)
15288 dyj=dc_norm(2,nres+j)
15289 dzj=dc_norm(3,nres+j)
15290 dscj_inv=vbld_inv(j+nres)
15292 chi1=chi(itypi,itypj)
15293 chi2=chi(itypj,itypi)
15300 alf12=0.5D0*(alf1+alf2)
15302 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15303 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
15304 ! The following are set in sc_angular
15308 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
15309 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
15310 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
15312 rij=1.0D0/rij ! Reset this so it makes sense
15314 sig0ij=sigma(itypi,itypj)
15315 sig=sig0ij*dsqrt(1.0D0/sigsq)
15318 ljA=eps1*eps2rt**2*eps3rt**2
15319 ljB=ljA*bb(itypi,itypj)
15320 ljA=ljA*aa(itypi,itypj)
15321 ljxm=ljXs+(-2.0D0*aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
15326 deltat12=om2-om1+2.0d0
15327 cosphi=om12-om1*om2
15331 +akth*(deltat1*deltat1+deltat2*deltat2) &
15332 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
15333 ssxm=ssXs-0.5D0*ssB/ssA
15335 !-------TESTING CODE
15336 !$$$c Some extra output
15337 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
15338 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
15339 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
15340 !$$$ if (ssx0.gt.0.0d0) then
15341 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
15345 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
15346 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
15347 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
15349 !-------END TESTING CODE
15351 !-------TESTING CODE
15352 ! Stop and plot energy and derivative as a function of distance
15353 if (checkstop) then
15354 ssm=ssC-0.25D0*ssB*ssB/ssA
15355 ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
15356 if (ssm.lt.ljm .and. &
15357 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
15365 if (.not.checkstop) then
15370 do icheck=0,nicheck
15371 do jcheck=-1,njcheck
15372 if (checkstop) rij=(ssxm-1.0d0)+ &
15373 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
15374 !-------END TESTING CODE
15376 if (rij.gt.ljxm) then
15379 fac=(1.0D0/ljd)**expon
15380 e1=fac*fac*aa(itypi,itypj)
15381 e2=fac*bb(itypi,itypj)
15382 eij=eps1*eps2rt*eps3rt*(e1+e2)
15385 eij=eij*eps2rt*eps3rt
15388 e1=e1*eps1*eps2rt**2*eps3rt**2
15389 ed=-expon*(e1+eij)/ljd
15391 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
15392 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
15393 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
15394 -2.0D0*alf12*eps3der+sigder*sigsq_om12
15395 else if (rij.lt.ssxm) then
15398 eij=ssA*ssd*ssd+ssB*ssd+ssC
15400 ed=2*akcm*ssd+akct*deltat12
15402 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
15403 eom1=-2*akth*deltat1-pom1-om2*pom2
15404 eom2= 2*akth*deltat2+pom1-om1*pom2
15407 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
15409 d_ssxm(1)=0.5D0*akct/ssA
15410 d_ssxm(2)=-d_ssxm(1)
15413 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
15414 d_ljxm(2)=d_ljxm(1)*sigsq_om2
15415 d_ljxm(3)=d_ljxm(1)*sigsq_om12
15416 d_ljxm(1)=d_ljxm(1)*sigsq_om1
15418 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
15419 xm=0.5d0*(ssxm+ljxm)
15421 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
15423 if (rij.lt.xm) then
15425 ssm=ssC-0.25D0*ssB*ssB/ssA
15426 d_ssm(1)=0.5D0*akct*ssB/ssA
15427 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
15428 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
15430 f1=(rij-xm)/(ssxm-xm)
15431 f2=(rij-ssxm)/(xm-ssxm)
15435 delta_inv=1.0d0/(xm-ssxm)
15436 deltasq_inv=delta_inv*delta_inv
15438 fac1=deltasq_inv*fac*(xm-rij)
15439 fac2=deltasq_inv*fac*(rij-ssxm)
15440 ed=delta_inv*(Ht*hd2-ssm*hd1)
15441 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
15442 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
15443 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
15446 ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
15447 d_ljm(1)=-0.5D0*bb(itypi,itypj)/aa(itypi,itypj)*ljB
15448 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
15449 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
15451 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
15452 f1=(rij-ljxm)/(xm-ljxm)
15453 f2=(rij-xm)/(ljxm-xm)
15457 delta_inv=1.0d0/(ljxm-xm)
15458 deltasq_inv=delta_inv*delta_inv
15460 fac1=deltasq_inv*fac*(ljxm-rij)
15461 fac2=deltasq_inv*fac*(rij-xm)
15462 ed=delta_inv*(ljm*hd2-Ht*hd1)
15463 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
15464 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
15465 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
15467 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
15469 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
15475 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
15476 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
15477 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
15479 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
15480 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
15481 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
15482 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
15483 !$$$ d_ssm(3)=omega
15485 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
15487 !$$$ d_ljm(k)=ljm*d_ljB(k)
15491 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
15492 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
15493 !$$$ d_ss(2)=akct*ssd
15494 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
15495 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
15498 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
15499 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
15500 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
15502 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
15503 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
15505 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
15507 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
15508 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
15509 !$$$ h1=h_base(f1,hd1)
15510 !$$$ h2=h_base(f2,hd2)
15511 !$$$ eij=ss*h1+ljf*h2
15512 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
15513 !$$$ deltasq_inv=delta_inv*delta_inv
15514 !$$$ fac=ljf*hd2-ss*hd1
15515 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
15516 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
15517 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
15518 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
15519 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
15520 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
15521 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
15523 !$$$ havebond=.false.
15524 !$$$ if (ed.gt.0.0d0) havebond=.true.
15525 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
15532 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
15533 ! write(iout,'(a15,f12.2,f8.1,2i5)')
15534 ! & "SSBOND_E_FORM",totT,t_bath,i,j
15538 dyn_ssbond_ij(i,j)=eij
15539 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
15540 dyn_ssbond_ij(i,j)=1.0d300
15543 ! write(iout,'(a15,f12.2,f8.1,2i5)')
15544 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
15549 !-------TESTING CODE
15550 if (checkstop) then
15551 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
15552 "CHECKSTOP",rij,eij,ed
15556 if (checkstop) then
15557 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
15560 if (checkstop) then
15564 !-------END TESTING CODE
15567 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
15568 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
15571 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
15574 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
15575 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
15576 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
15577 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
15578 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
15579 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
15583 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
15588 gvdwc(l,i)=gvdwc(l,i)-gg(l)
15589 gvdwc(l,j)=gvdwc(l,j)+gg(l)
15593 end subroutine dyn_ssbond_ene
15594 !-----------------------------------------------------------------------------
15595 real(kind=8) function h_base(x,deriv)
15596 ! A smooth function going 0->1 in range [0,1]
15597 ! It should NOT be called outside range [0,1], it will not work there.
15604 real(kind=8) :: deriv
15607 real(kind=8) :: xsq
15610 ! Two parabolas put together. First derivative zero at extrema
15611 !$$$ if (x.lt.0.5D0) then
15612 !$$$ h_base=2.0D0*x*x
15616 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
15617 !$$$ deriv=4.0D0*deriv
15620 ! Third degree polynomial. First derivative zero at extrema
15621 h_base=x*x*(3.0d0-2.0d0*x)
15622 deriv=6.0d0*x*(1.0d0-x)
15624 ! Fifth degree polynomial. First and second derivatives zero at extrema
15626 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
15628 !$$$ deriv=deriv*deriv
15629 !$$$ deriv=30.0d0*xsq*deriv
15632 end function h_base
15633 !-----------------------------------------------------------------------------
15634 subroutine dyn_set_nss
15635 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
15637 use MD_data, only: totT,t_bath
15639 ! include 'DIMENSIONS'
15643 ! include 'COMMON.SBRIDGE'
15644 ! include 'COMMON.CHAIN'
15645 ! include 'COMMON.IOUNITS'
15646 ! include 'COMMON.SETUP'
15649 ! include 'COMMON.MD'
15653 real(kind=8) :: emin
15654 integer :: i,j,imin,ierr
15655 integer :: diff,allnss,newnss
15656 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
15659 integer,dimension(0:nfgtasks) :: i_newnss
15660 integer,dimension(0:nfgtasks) :: displ
15661 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
15662 integer :: g_newnss
15667 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
15676 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
15680 if (allflag(i).eq.0 .and. &
15681 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
15682 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
15686 if (emin.lt.1.0d300) then
15689 if (allflag(i).eq.0 .and. &
15690 (allihpb(i).eq.allihpb(imin) .or. &
15691 alljhpb(i).eq.allihpb(imin) .or. &
15692 allihpb(i).eq.alljhpb(imin) .or. &
15693 alljhpb(i).eq.alljhpb(imin))) then
15700 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
15704 if (allflag(i).eq.1) then
15706 newihpb(newnss)=allihpb(i)
15707 newjhpb(newnss)=alljhpb(i)
15712 if (nfgtasks.gt.1)then
15714 call MPI_Reduce(newnss,g_newnss,1,&
15715 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
15716 call MPI_Gather(newnss,1,MPI_INTEGER,&
15717 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
15719 do i=1,nfgtasks-1,1
15720 displ(i)=i_newnss(i-1)+displ(i-1)
15722 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
15723 g_newihpb,i_newnss,displ,MPI_INTEGER,&
15725 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
15726 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
15728 if(fg_rank.eq.0) then
15729 ! print *,'g_newnss',g_newnss
15730 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
15731 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
15734 newihpb(i)=g_newihpb(i)
15735 newjhpb(i)=g_newjhpb(i)
15743 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
15748 if (idssb(i).eq.newihpb(j) .and. &
15749 jdssb(i).eq.newjhpb(j)) found=.true.
15753 if (.not.found.and.fg_rank.eq.0) &
15754 write(iout,'(a15,f12.2,f8.1,2i5)') &
15755 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
15763 if (newihpb(i).eq.idssb(j) .and. &
15764 newjhpb(i).eq.jdssb(j)) found=.true.
15768 if (.not.found.and.fg_rank.eq.0) &
15769 write(iout,'(a15,f12.2,f8.1,2i5)') &
15770 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
15777 idssb(i)=newihpb(i)
15778 jdssb(i)=newjhpb(i)
15782 end subroutine dyn_set_nss
15783 !-----------------------------------------------------------------------------
15785 subroutine read_ssHist
15788 ! include 'DIMENSIONS'
15789 ! include "DIMENSIONS.FREE"
15790 ! include 'COMMON.FREE'
15793 character(len=80) :: controlcard
15796 call card_concat(controlcard,.true.)
15797 read(controlcard,*) &
15798 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
15802 end subroutine read_ssHist
15804 !-----------------------------------------------------------------------------
15805 integer function indmat(i,j)
15807 ! get the position of the jth ijth fragment of the chain coordinate system
15808 ! in the fromto array.
15811 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
15813 end function indmat
15814 !-----------------------------------------------------------------------------
15815 real(kind=8) function sigm(x)
15821 !-----------------------------------------------------------------------------
15822 !-----------------------------------------------------------------------------
15823 subroutine alloc_ener_arrays
15824 !EL Allocation of arrays used by module energy
15826 !el local variables
15829 if(nres.lt.100) then
15831 elseif(nres.lt.200) then
15832 maxconts=0.8*nres ! Max. number of contacts per residue
15834 maxconts=0.6*nres ! (maxconts=maxres/4)
15836 maxcont=12*nres ! Max. number of SC contacts
15837 maxvar=6*nres ! Max. number of variables
15838 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
15839 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
15840 !----------------------
15841 ! arrays in subroutine init_int_table
15842 allocate(nint_gr(nres))
15843 allocate(nscp_gr(nres))
15844 allocate(ielstart(nres))
15845 allocate(ielend(nres)) !(maxres)
15846 allocate(istart(nres,maxint_gr))
15847 allocate(iend(nres,maxint_gr)) !(maxres,maxint_gr)
15848 allocate(iscpstart(nres,maxint_gr))
15849 allocate(iscpend(nres,maxint_gr)) !(maxres,maxint_gr)
15850 allocate(ielstart_vdw(nres))
15851 allocate(ielend_vdw(nres)) !(maxres)
15853 allocate(lentyp(0:nfgtasks-1)) !(0:maxprocs-1)
15854 !----------------------
15856 ! common /contacts/
15857 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
15858 allocate(icont(2,maxcont)) !(2,maxcont)
15859 ! common /contacts1/
15860 allocate(num_cont(0:nres+4)) !(maxres)
15861 allocate(jcont(maxconts,nres)) !(maxconts,maxres)
15862 allocate(facont(maxconts,nres)) !(maxconts,maxres)
15863 allocate(gacont(3,maxconts,nres)) !(3,maxconts,maxres)
15864 ! common /contacts_hb/
15865 allocate(gacontp_hb1(3,maxconts,nres))
15866 allocate(gacontp_hb2(3,maxconts,nres))
15867 allocate(gacontp_hb3(3,maxconts,nres))
15868 allocate(gacontm_hb1(3,maxconts,nres))
15869 allocate(gacontm_hb2(3,maxconts,nres))
15870 allocate(gacontm_hb3(3,maxconts,nres))
15871 allocate(gacont_hbr(3,maxconts,nres))
15872 allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres)
15873 allocate(facont_hb(maxconts,nres))
15874 allocate(ees0p(maxconts,nres))
15875 allocate(ees0m(maxconts,nres))
15876 allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
15877 allocate(num_cont_hb(nres)) !(maxres)
15878 allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
15880 allocate(Ug(2,2,nres))
15881 allocate(Ugder(2,2,nres))
15882 allocate(Ug2(2,2,nres))
15883 allocate(Ug2der(2,2,nres)) !(2,2,maxres)
15884 allocate(obrot(2,nres))
15885 allocate(obrot2(2,nres))
15886 allocate(obrot_der(2,nres))
15887 allocate(obrot2_der(2,nres)) !(2,maxres)
15888 ! common /precomp1/
15889 allocate(mu(2,nres))
15890 allocate(muder(2,nres))
15891 allocate(Ub2(2,nres))
15892 allocate(Ub2der(2,nres))
15893 allocate(Ctobr(2,nres))
15894 allocate(Ctobrder(2,nres))
15895 allocate(Dtobr2(2,nres))
15896 allocate(Dtobr2der(2,nres)) !(2,maxres)
15897 allocate(EUg(2,2,nres))
15898 allocate(EUgder(2,2,nres))
15899 allocate(CUg(2,2,nres))
15900 allocate(CUgder(2,2,nres))
15901 allocate(DUg(2,2,nres))
15902 allocate(Dugder(2,2,nres))
15903 allocate(DtUg2(2,2,nres))
15904 allocate(DtUg2der(2,2,nres)) !(2,2,maxres)
15905 ! common /precomp2/
15906 allocate(Ug2Db1t(2,nres))
15907 allocate(Ug2Db1tder(2,nres))
15908 allocate(CUgb2(2,nres))
15909 allocate(CUgb2der(2,nres)) !(2,maxres)
15910 allocate(EUgC(2,2,nres))
15911 allocate(EUgCder(2,2,nres))
15912 allocate(EUgD(2,2,nres))
15913 allocate(EUgDder(2,2,nres))
15914 allocate(DtUg2EUg(2,2,nres))
15915 allocate(Ug2DtEUg(2,2,nres)) !(2,2,maxres)
15916 allocate(Ug2DtEUgder(2,2,2,nres))
15917 allocate(DtUg2EUgder(2,2,2,nres)) !(2,2,2,maxres)
15918 ! common /rotat_old/
15919 allocate(costab(nres))
15920 allocate(sintab(nres))
15921 allocate(costab2(nres))
15922 allocate(sintab2(nres)) !(maxres)
15924 allocate(a_chuj(2,2,maxconts,nres))
15925 !(2,2,maxconts,maxres)(maxconts=maxres/4)
15926 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
15927 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
15928 ! common /contdistrib/
15929 allocate(ncont_sent(nres))
15930 allocate(ncont_recv(nres))
15932 allocate(iat_sent(nres)) !(maxres)
15933 allocate(iint_sent(4,nres,nres))
15934 allocate(iint_sent_local(4,nres,nres)) !(4,maxres,maxres)
15935 allocate(iturn3_sent(4,0:nres+4))
15936 allocate(iturn4_sent(4,0:nres+4))
15937 allocate(iturn3_sent_local(4,nres))
15938 allocate(iturn4_sent_local(4,nres)) !(4,maxres)
15939 allocate(itask_cont_from(0:nfgtasks-1))
15940 allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
15942 !----------------------
15945 allocate(dcdv(6,maxdim))
15946 allocate(dxdv(6,maxdim)) !(6,maxdim)
15947 allocate(dxds(6,nres)) !(6,maxres)
15948 allocate(gradx(3,nres,0:2))
15949 allocate(gradc(3,nres,0:2)) !(3,maxres,2)
15950 allocate(gvdwx(3,nres))
15951 allocate(gvdwc(3,nres))
15952 allocate(gelc(3,nres))
15953 allocate(gelc_long(3,nres))
15954 allocate(gvdwpp(3,nres))
15955 allocate(gvdwc_scpp(3,nres))
15956 allocate(gradx_scp(3,nres))
15957 allocate(gvdwc_scp(3,nres))
15958 allocate(ghpbx(3,nres))
15959 allocate(ghpbc(3,nres))
15960 allocate(gradcorr(3,nres))
15961 allocate(gradcorr_long(3,nres))
15962 allocate(gradcorr5_long(3,nres))
15963 allocate(gradcorr6_long(3,nres))
15964 allocate(gcorr6_turn_long(3,nres))
15965 allocate(gradxorr(3,nres))
15966 allocate(gradcorr5(3,nres))
15967 allocate(gradcorr6(3,nres)) !(3,maxres)
15968 allocate(gloc(0:maxvar,0:2))
15969 allocate(gloc_x(0:maxvar,2)) !(maxvar,2)
15970 allocate(gel_loc(3,nres))
15971 allocate(gel_loc_long(3,nres))
15972 allocate(gcorr3_turn(3,nres))
15973 allocate(gcorr4_turn(3,nres))
15974 allocate(gcorr6_turn(3,nres))
15975 allocate(gradb(3,nres))
15976 allocate(gradbx(3,nres)) !(3,maxres)
15977 allocate(gel_loc_loc(maxvar))
15978 allocate(gel_loc_turn3(maxvar))
15979 allocate(gel_loc_turn4(maxvar))
15980 allocate(gel_loc_turn6(maxvar))
15981 allocate(gcorr_loc(maxvar))
15982 allocate(g_corr5_loc(maxvar))
15983 allocate(g_corr6_loc(maxvar)) !(maxvar)
15984 allocate(gsccorc(3,nres))
15985 allocate(gsccorx(3,nres)) !(3,maxres)
15986 allocate(gsccor_loc(nres)) !(maxres)
15987 allocate(dtheta(3,2,nres)) !(3,2,maxres)
15988 allocate(gscloc(3,nres))
15989 allocate(gsclocx(3,nres)) !(3,maxres)
15990 allocate(dphi(3,3,nres))
15991 allocate(dalpha(3,3,nres))
15992 allocate(domega(3,3,nres)) !(3,3,maxres)
15993 ! common /deriv_scloc/
15994 allocate(dXX_C1tab(3,nres))
15995 allocate(dYY_C1tab(3,nres))
15996 allocate(dZZ_C1tab(3,nres))
15997 allocate(dXX_Ctab(3,nres))
15998 allocate(dYY_Ctab(3,nres))
15999 allocate(dZZ_Ctab(3,nres))
16000 allocate(dXX_XYZtab(3,nres))
16001 allocate(dYY_XYZtab(3,nres))
16002 allocate(dZZ_XYZtab(3,nres)) !(3,maxres)
16004 allocate(jgrad_start(nres))
16005 allocate(jgrad_end(nres)) !(maxres)
16008 allocate(ibond_displ(0:nfgtasks-1))
16009 allocate(ibond_count(0:nfgtasks-1))
16010 allocate(ithet_displ(0:nfgtasks-1))
16011 allocate(ithet_count(0:nfgtasks-1))
16012 allocate(iphi_displ(0:nfgtasks-1))
16013 allocate(iphi_count(0:nfgtasks-1))
16014 allocate(iphi1_displ(0:nfgtasks-1))
16015 allocate(iphi1_count(0:nfgtasks-1))
16016 allocate(ivec_displ(0:nfgtasks-1))
16017 allocate(ivec_count(0:nfgtasks-1))
16018 allocate(iset_displ(0:nfgtasks-1))
16019 allocate(iset_count(0:nfgtasks-1))
16020 allocate(iint_count(0:nfgtasks-1))
16021 allocate(iint_displ(0:nfgtasks-1)) !(0:max_fg_procs-1)
16022 !----------------------
16025 allocate(gcart(3,0:nres))
16026 allocate(gxcart(3,0:nres)) !(3,0:MAXRES)
16027 allocate(gradcag(3,nres))
16028 allocate(gradxag(3,nres)) !(3,MAXRES)
16029 ! common /back_constr/
16030 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
16031 allocate(dutheta(nres))
16032 allocate(dugamma(nres)) !(maxres)
16033 allocate(duscdiff(3,nres))
16034 allocate(duscdiffx(3,nres)) !(3,maxres)
16035 !el i io:read_fragments
16036 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
16037 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
16039 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
16040 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
16041 allocate(mset(0:nprocs)) !(maxprocs/20)
16045 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
16046 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
16047 allocate(dUdconst(3,0:nres))
16048 allocate(dUdxconst(3,0:nres))
16049 allocate(dqwol(3,0:nres))
16050 allocate(dxqwol(3,0:nres)) !(3,0:MAXRES)
16051 !----------------------
16053 ! common /sbridge/ in io_common: read_bridge
16054 !el allocate((:),allocatable :: iss !(maxss)
16055 ! common /links/ in io_common: read_bridge
16056 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
16057 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
16058 ! common /dyn_ssbond/
16059 ! and side-chain vectors in theta or phi.
16060 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4)) !(maxres,maxres)
16063 dyn_ssbond_ij(i,j)=1.0d300
16068 allocate(idssb(nss),jdssb(nss)) !(maxdim)
16070 allocate(dyn_ss_mask(nres)) !(maxres)
16072 dyn_ss_mask(i)=.false.
16074 !----------------------
16076 ! Parameters of the SCCOR term
16078 !el in io_conf: parmread
16079 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
16080 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
16081 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
16082 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
16083 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
16084 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
16085 ! allocate(vlor1sccor(maxterm_sccor,20,20))
16086 ! allocate(vlor2sccor(maxterm_sccor,20,20))
16087 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
16089 allocate(gloc_sc(3,0:2*nres,0:10)) !(3,0:maxres2,10)maxres2=2*maxres
16090 allocate(dcostau(3,3,3,2*nres))
16091 allocate(dsintau(3,3,3,2*nres))
16092 allocate(dtauangle(3,3,3,2*nres))
16093 allocate(dcosomicron(3,3,3,2*nres))
16094 allocate(domicron(3,3,3,2*nres)) !(3,3,3,maxres2)maxres2=2*maxres
16095 !----------------------
16097 ! Parameters of the SC rotamers (local) term
16098 ! common/scrot/ in io_conf: parmread
16099 ! allocate((:,:),allocatable :: sc_parmin !(maxsccoef,ntyp)
16100 !----------------------
16102 ! common /torcnstr/
16103 !el in io_conf:molread
16104 ! allocate((:),allocatable :: idih_constr,idih_nconstr !(maxdih_constr)
16105 ! allocate((:),allocatable :: phi0,drange !(maxdih_constr)
16106 !----------------------
16108 ! common/torsion/ in io_conf: parmread
16109 ! allocate((:,:,:),allocatable :: v0 !(-maxtor:maxtor,-maxtor:maxtor,2)
16110 ! allocate((:,:,:,:),allocatable :: v1,v2 !(maxterm,-maxtor:maxtor,-maxtor:maxtor,2)
16111 ! allocate((:,:,:),allocatable :: vlor1 !(maxlor,-maxtor:maxtor,-maxtor:maxtor)
16112 ! allocate((:,:,:),allocatable :: vlor2,vlor3 !(maxlor,maxtor,maxtor)
16113 ! allocate((:),allocatable :: itortyp !(-ntyp1:ntyp1)
16114 ! allocate((:,:,:),allocatable :: nterm,nlor !(-maxtor:maxtor,-maxtor:maxtor,2)
16116 ! common /torsiond/ in io_conf: parmread
16117 ! allocate((:,:,:,:,:,:),allocatable :: v1c,v1s
16118 !(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2)
16119 ! allocate((:,:,:,:,:,:),allocatable :: v2c,v2s
16120 !(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2)
16121 ! allocate((:,:,:,:),allocatable :: ntermd_1,ntermd_2
16122 !(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2)
16123 ! common/fourier/ in io_conf: parmread
16124 ! allocate((:,:),allocatable :: b1,b2,&
16125 ! b1tilde !(2,-maxtor:maxtor)
16126 ! allocate((:,:,:),allocatable :: cc,dd,ee,&
16127 ! ctilde,dtilde !(2,2,-maxtor:maxtor)
16128 !----------------------
16131 allocate(varall(maxvar)) !(maxvar)(maxvar=6*maxres)
16132 allocate(mask_theta(nres))
16133 allocate(mask_phi(nres))
16134 allocate(mask_side(nres)) !(maxres)
16135 !----------------------
16138 allocate(uy(3,nres))
16139 allocate(uz(3,nres)) !(3,maxres)
16140 allocate(uygrad(3,3,2,nres))
16141 allocate(uzgrad(3,3,2,nres)) !(3,3,2,maxres)
16144 end subroutine alloc_ener_arrays
16145 !-----------------------------------------------------------------------------
16146 !-----------------------------------------------------------------------------