2 !-----------------------------------------------------------------------------
13 !-----------------------------------------------------------------------------
14 ! Max. number of contacts per residue
16 !-----------------------------------------------------------------------------
17 ! Max. number of derivatives of virtual-bond and side-chain vectors in theta
20 !-----------------------------------------------------------------------------
21 ! Max. number of SC contacts
23 !-----------------------------------------------------------------------------
24 ! Max. number of variables
26 !-----------------------------------------------------------------------------
27 ! Max number of torsional terms in SCCOR in control_data
28 ! integer,parameter :: maxterm_sccor=6
29 !-----------------------------------------------------------------------------
30 ! Maximum number of SC local term fitting function coefficiants
31 integer,parameter :: maxsccoef=65
32 !-----------------------------------------------------------------------------
33 ! commom.calc common/calc/
34 !-----------------------------------------------------------------------------
37 ! Change 12/1/95 - common block CONTACTS1 included.
39 integer,dimension(:),allocatable :: num_cont !(maxres)
40 integer,dimension(:,:),allocatable :: jcont !(maxconts,maxres)
41 real(kind=8),dimension(:,:),allocatable :: facont !(maxconts,maxres)
42 real(kind=8),dimension(:,:,:),allocatable :: gacont !(3,maxconts,maxres)
44 ! 12/26/95 - H-bonding contacts
45 ! common /contacts_hb/
46 real(kind=8),dimension(:,:,:),allocatable :: gacontp_hb1,gacontp_hb2,&
47 gacontp_hb3,gacontm_hb1,gacontm_hb2,gacontm_hb3,gacont_hbr,grij_hb_cont !(3,maxconts,maxres)
48 real(kind=8),dimension(:,:),allocatable :: facont_hb,ees0p,&
49 ees0m,d_cont !(maxconts,maxres)
50 integer,dimension(:),allocatable :: num_cont_hb !(maxres)
51 integer,dimension(:,:),allocatable :: jcont_hb !(maxconts,maxres)
52 ! 9/23/99 Added improper rotation matrices and matrices of dipole-dipole
54 ! 7/25/08 commented out; not needed when cumulants used
55 ! Interactions of pseudo-dipoles generated by loc-el interactions.
57 real(kind=8),dimension(:,:,:),allocatable :: dip,&
58 dipderg !(4,maxconts,maxres)
59 real(kind=8),dimension(:,:,:,:,:),allocatable :: dipderx !(3,5,4,maxconts,maxres)
60 ! 10/30/99 Added other pre-computed vectors and matrices needed
61 ! to calculate three - six-order el-loc correlation terms
63 real(kind=8),dimension(:,:,:),allocatable :: Ug,Ugder,Ug2,Ug2der !(2,2,maxres)
64 real(kind=8),dimension(:,:),allocatable :: obrot,obrot2,obrot_der,&
65 obrot2_der !(2,maxres)
67 ! This common block contains vectors and matrices dependent on a single
70 real(kind=8),dimension(:,:),allocatable :: mu,muder,Ub2,Ub2der,&
71 Ctobr,Ctobrder,Dtobr2,Dtobr2der !(2,maxres)
72 real(kind=8),dimension(:,:,:),allocatable :: EUg,EUgder,CUg,&
73 CUgder,DUg,Dugder,DtUg2,DtUg2der !(2,2,maxres)
74 ! This common block contains vectors and matrices dependent on two
75 ! consecutive amino-acid residues.
77 real(kind=8),dimension(:,:),allocatable :: Ug2Db1t,Ug2Db1tder,&
78 CUgb2,CUgb2der !(2,maxres)
79 real(kind=8),dimension(:,:,:),allocatable :: EUgC,EUgCder,&
80 EUgD,EUgDder,DtUg2EUg,Ug2DtEUg !(2,2,maxres)
81 real(kind=8),dimension(:,:,:,:),allocatable :: Ug2DtEUgder,&
82 DtUg2EUgder !(2,2,2,maxres)
84 real(kind=8),dimension(:),allocatable :: costab,sintab,&
85 costab2,sintab2 !(maxres)
86 ! This common block contains dipole-interaction matrices and their
87 ! Cartesian derivatives.
89 real(kind=8),dimension(:,:,:,:),allocatable :: a_chuj !(2,2,maxconts,maxres)
90 real(kind=8),dimension(:,:,:,:,:,:),allocatable :: a_chuj_der !(2,2,3,5,maxconts,maxres)
92 real(kind=8),dimension(2,2,2) :: AEA,AEAderg,EAEA,AECA,&
93 AECAderg,ADtEA,ADtEA1,AEAb1,AEAb1derg,AEAb2
94 real(kind=8),dimension(2,2,2,2) :: EAEAderg,ADtEAderg,&
96 real(kind=8),dimension(2,2,3,5,2,2) :: AEAderx,EAEAderx,&
97 AECAderx,ADtEAderx,ADtEA1derx
98 real(kind=8),dimension(2,3,5,2,2,2) :: AEAb1derx,AEAb2derx
99 real(kind=8),dimension(3,2) :: g_contij
100 real(kind=8) :: ekont
101 ! 12/13/2008 (again Poland-Jaruzel war anniversary)
102 ! RE: Parallelization of 4th and higher order loc-el correlations
103 ! common /contdistrib/
104 integer,dimension(:),allocatable :: ncont_sent,ncont_recv !(maxres)
105 ! ncont_sent,ncont_recv są w multibody_ello i multibody_hb
106 !-----------------------------------------------------------------------------
109 ! real(kind=8),dimension(:,:),allocatable :: dcdv,dxdv !(6,maxdim)
110 ! real(kind=8),dimension(:,:),allocatable :: dxds !(6,maxres)
111 ! real(kind=8),dimension(:,:,:),allocatable :: gradx,gradc !(3,maxres,2)
112 real(kind=8),dimension(:,:),allocatable :: gvdwc,gelc,gelc_long,&
113 gvdwpp,gvdwc_scpp,gradx_scp,gvdwc_scp,ghpbx,ghpbc,&
114 gradcorr,gradcorr_long,gradcorr5_long,gradcorr6_long,&
115 gcorr6_turn_long,gradxorr,gradcorr5,gradcorr6 !(3,maxres)
116 ! real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2)
117 real(kind=8),dimension(:,:),allocatable :: gel_loc,gel_loc_long,&
118 gcorr3_turn,gcorr4_turn,gcorr6_turn,gradb,gradbx !(3,maxres)
119 real(kind=8),dimension(:),allocatable :: gel_loc_loc,&
120 gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc,g_corr5_loc,&
121 g_corr6_loc !(maxvar)
122 real(kind=8),dimension(:,:),allocatable :: gsccorc,gsccorx !(3,maxres)
123 real(kind=8),dimension(:),allocatable :: gsccor_loc !(maxres)
124 ! real(kind=8),dimension(:,:,:),allocatable :: dtheta !(3,2,maxres)
125 real(kind=8),dimension(:,:),allocatable :: gscloc,gsclocx !(3,maxres)
126 ! real(kind=8),dimension(:,:,:),allocatable :: dphi,dalpha,domega !(3,3,maxres)
129 real(kind=8),dimension(3,5,2) :: derx,derx_turn
130 ! common /deriv_scloc/
131 real(kind=8),dimension(:,:),allocatable :: dXX_C1tab,dYY_C1tab,&
132 dZZ_C1tab,dXX_Ctab,dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,&
133 dZZ_XYZtab !(3,maxres)
134 !-----------------------------------------------------------------------------
137 real(kind=8) :: gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,&
138 gradb_max,ghpbc_max,&
139 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
140 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
141 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
142 gsccorx_max,gsclocx_max
143 !-----------------------------------------------------------------------------
145 ! common /back_constr/
146 real(kind=8),dimension(:),allocatable :: dutheta,dugamma !(maxres)
147 real(kind=8),dimension(:,:),allocatable :: duscdiff,duscdiffx !(3,maxres)
149 real(kind=8) :: Ucdfrag,Ucdpair
150 real(kind=8),dimension(:,:),allocatable :: dUdconst,dUdxconst,&
151 dqwol,dxqwol !(3,0:MAXRES)
152 !-----------------------------------------------------------------------------
154 ! common /dyn_ssbond/
155 real(kind=8),dimension(:,:),allocatable :: dyn_ssbond_ij !(maxres,maxres)
156 !-----------------------------------------------------------------------------
158 ! Parameters of the SCCOR term
160 real(kind=8),dimension(:,:,:,:),allocatable :: dcostau,dsintau,&
161 dcosomicron,domicron !(3,3,3,maxres2)
162 !-----------------------------------------------------------------------------
165 real(kind=8),dimension(:,:),allocatable :: uy,uz !(3,maxres)
166 real(kind=8),dimension(:,:,:,:),allocatable :: uygrad,uzgrad !(3,3,2,maxres)
167 !-----------------------------------------------------------------------------
168 ! common /przechowalnia/
169 real(kind=8),dimension(:,:,:),allocatable :: zapas !(max_dim,maxconts,max_fg_procs)
170 real(kind=8),dimension(:,:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
171 !-----------------------------------------------------------------------------
172 !-----------------------------------------------------------------------------
175 !-----------------------------------------------------------------------------
177 !-----------------------------------------------------------------------------
178 ! energy_p_new_barrier.F
179 !-----------------------------------------------------------------------------
180 subroutine etotal(energia)
181 ! implicit real*8 (a-h,o-z)
182 ! include 'DIMENSIONS'
183 use MD_data, only: totT
187 !MS$ATTRIBUTES C :: proc_proc
193 ! include 'COMMON.SETUP'
194 ! include 'COMMON.IOUNITS'
195 real(kind=8),dimension(0:n_ene) :: energia
196 ! include 'COMMON.LOCAL'
197 ! include 'COMMON.FFIELD'
198 ! include 'COMMON.DERIV'
199 ! include 'COMMON.INTERACT'
200 ! include 'COMMON.SBRIDGE'
201 ! include 'COMMON.CHAIN'
202 ! include 'COMMON.VAR'
203 ! include 'COMMON.MD'
204 ! include 'COMMON.CONTROL'
205 ! include 'COMMON.TIME1'
206 real(kind=8) :: time00
208 integer :: n_corr,n_corr1,ierror
209 real(kind=8) :: etors,edihcnstr,etors_d,esccor,ehpb
210 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,escloc,ees,eel_loc
211 real(kind=8) :: eello_turn3,eello_turn4,estr,ebe
212 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
215 real(kind=8) :: weights_(n_ene) !,time_Bcast,time_Bcastw
216 ! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
217 ! & " nfgtasks",nfgtasks
218 if (nfgtasks.gt.1) then
220 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
221 if (fg_rank.eq.0) then
222 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
223 ! print *,"Processor",myrank," BROADCAST iorder"
224 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
225 ! FG slaves as WEIGHTS array.
245 ! FG Master broadcasts the WEIGHTS_ array
246 call MPI_Bcast(weights_(1),n_ene,&
247 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
249 ! FG slaves receive the WEIGHTS array
250 call MPI_Bcast(weights(1),n_ene,&
251 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
272 time_Bcast=time_Bcast+MPI_Wtime()-time00
273 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
274 ! call chainbuild_cart
276 ! print *,'Processor',myrank,' calling etotal ipot=',ipot
277 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
279 ! if (modecalc.eq.12.or.modecalc.eq.14) then
280 ! call int_from_cart1(.false.)
287 ! Compute the side-chain and electrostatic interaction energy
289 ! goto (101,102,103,104,105,106) ipot
291 ! Lennard-Jones potential.
295 !d print '(a)','Exit ELJcall el'
297 ! Lennard-Jones-Kihara potential (shifted).
298 ! 102 call eljk(evdw)
302 ! Berne-Pechukas potential (dilated LJ, angular dependence).
307 ! Gay-Berne potential (shifted LJ, angular dependence).
312 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
313 ! 105 call egbv(evdw)
317 ! Soft-sphere potential
318 ! 106 call e_softsphere(evdw)
320 call e_softsphere(evdw)
322 ! Calculate electrostatic (H-bonding) energy of the main chain.
326 write(iout,*)"Wrong ipot"
333 !mc Sep-06: egb takes care of dynamic ss bonds too
335 ! if (dyn_ss) call dyn_set_nss
336 ! print *,"Processor",myrank," computed USCSC"
342 time_vec=time_vec+MPI_Wtime()-time01
344 ! print *,"Processor",myrank," left VEC_AND_DERIV"
347 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
348 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
349 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
350 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
352 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
353 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
354 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
355 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
357 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
358 ! write (iout,*) "ELEC calc"
367 ! write (iout,*) "Soft-spheer ELEC potential"
368 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
371 ! print *,"Processor",myrank," computed UELEC"
373 ! Calculate excluded-volume interaction energy between peptide groups
376 !elwrite(iout,*) "in etotal calc exc;luded",ipot
380 call escp(evdw2,evdw2_14)
386 ! write (iout,*) "Soft-sphere SCP potential"
387 call escp_soft_sphere(evdw2,evdw2_14)
389 !elwrite(iout,*) "in etotal before ebond",ipot
392 ! Calculate the bond-stretching energy
395 !elwrite(iout,*) "in etotal afer ebond",ipot
398 ! Calculate the disulfide-bridge and other energy and the contributions
399 ! from other distance constraints.
400 ! print *,'Calling EHPB'
402 !elwrite(iout,*) "in etotal afer edis",ipot
403 ! print *,'EHPB exitted succesfully.'
405 ! Calculate the virtual-bond-angle energy.
407 if (wang.gt.0d0) then
412 ! print *,"Processor",myrank," computed UB"
414 ! Calculate the SC local energy.
417 !elwrite(iout,*) "in etotal afer esc",ipot
418 ! print *,"Processor",myrank," computed USC"
420 ! Calculate the virtual-bond torsional energy.
422 !d print *,'nterm=',nterm
424 call etor(etors,edihcnstr)
429 ! print *,"Processor",myrank," computed Utor"
431 ! 6/23/01 Calculate double-torsional energy
433 !elwrite(iout,*) "in etotal",ipot
434 if (wtor_d.gt.0) then
439 ! print *,"Processor",myrank," computed Utord"
441 ! 21/5/07 Calculate local sicdechain correlation energy
443 if (wsccor.gt.0.0d0) then
444 call eback_sc_corr(esccor)
448 ! print *,"Processor",myrank," computed Usccorr"
450 ! 12/1/95 Multi-body terms
454 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
455 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
456 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
457 !d write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
458 !d &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
465 !elwrite(iout,*) "in etotal",ipot
466 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
467 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
468 !d write (iout,*) "multibody_hb ecorr",ecorr
470 !elwrite(iout,*) "afeter multibody hb"
472 ! print *,"Processor",myrank," computed Ucorr"
474 ! If performing constraint dynamics, call the constraint energy
475 ! after the equilibration time
476 if(usampl.and.totT.gt.eq_time) then
477 !elwrite(iout,*) "afeter multibody hb"
479 !elwrite(iout,*) "afeter multibody hb"
481 !elwrite(iout,*) "afeter multibody hb"
486 !elwrite(iout,*) "after Econstr"
489 time_enecalc=time_enecalc+MPI_Wtime()-time00
491 ! print *,"Processor",myrank," computed Uconstr"
500 energia(2)=evdw2-evdw2_14
517 energia(8)=eello_turn3
518 energia(9)=eello_turn4
525 energia(19)=edihcnstr
527 energia(20)=Uconst+Uconst_back
529 ! Here are the energies showed per procesor if the are more processors
530 ! per molecule then we sum it up in sum_energy subroutine
531 ! print *," Processor",myrank," calls SUM_ENERGY"
532 call sum_energy(energia,.true.)
533 if (dyn_ss) call dyn_set_nss
534 ! print *," Processor",myrank," left SUM_ENERGY"
536 time_sumene=time_sumene+MPI_Wtime()-time00
538 !el call enerprint(energia)
539 !elwrite(iout,*)"finish etotal"
541 end subroutine etotal
542 !-----------------------------------------------------------------------------
543 subroutine sum_energy(energia,reduce)
544 ! implicit real*8 (a-h,o-z)
545 ! include 'DIMENSIONS'
549 !MS$ATTRIBUTES C :: proc_proc
555 ! include 'COMMON.SETUP'
556 ! include 'COMMON.IOUNITS'
557 real(kind=8) :: energia(0:n_ene),enebuff(0:n_ene+1)
558 ! include 'COMMON.FFIELD'
559 ! include 'COMMON.DERIV'
560 ! include 'COMMON.INTERACT'
561 ! include 'COMMON.SBRIDGE'
562 ! include 'COMMON.CHAIN'
563 ! include 'COMMON.VAR'
564 ! include 'COMMON.CONTROL'
565 ! include 'COMMON.TIME1'
567 real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
568 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
569 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot
573 real(kind=8) :: time00
574 if (nfgtasks.gt.1 .and. reduce) then
577 write (iout,*) "energies before REDUCE"
578 call enerprint(energia)
582 enebuff(i)=energia(i)
585 call MPI_Barrier(FG_COMM,IERR)
586 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
588 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,&
589 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
591 write (iout,*) "energies after REDUCE"
592 call enerprint(energia)
595 time_Reduce=time_Reduce+MPI_Wtime()-time00
597 if (fg_rank.eq.0) then
601 evdw2=energia(2)+energia(18)
617 eello_turn3=energia(8)
618 eello_turn4=energia(9)
625 edihcnstr=energia(19)
630 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
631 +wang*ebe+wtor*etors+wscloc*escloc &
632 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
633 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
634 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
635 +wbond*estr+Uconst+wsccor*esccor
637 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
638 +wang*ebe+wtor*etors+wscloc*escloc &
639 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
640 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
641 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
642 +wbond*estr+Uconst+wsccor*esccor
648 if (isnan(etot).ne.0) energia(0)=1.0d+99
650 if (isnan(etot)) energia(0)=1.0d+99
655 idumm=proc_proc(etot,i)
657 call proc_proc(etot,i)
659 if(i.eq.1)energia(0)=1.0d+99
664 ! call enerprint(energia)
667 end subroutine sum_energy
668 !-----------------------------------------------------------------------------
669 subroutine rescale_weights(t_bath)
670 ! implicit real*8 (a-h,o-z)
674 ! include 'DIMENSIONS'
675 ! include 'COMMON.IOUNITS'
676 ! include 'COMMON.FFIELD'
677 ! include 'COMMON.SBRIDGE'
678 real(kind=8) :: kfac=2.4d0
679 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644
681 real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6
682 real(kind=8) :: T0=3.0d2
685 ! facT=2*temp0/(t_bath+temp0)
686 if (rescale_mode.eq.0) then
693 else if (rescale_mode.eq.1) then
694 facT(1)=kfac/(kfac-1.0d0+t_bath/temp0)
695 facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
696 facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
697 facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
698 facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
700 !#if defined(WHAM_RUN) || defined(CLUSTER)
702 ! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
703 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
710 else if (rescale_mode.eq.2) then
716 facT(1)=licznik/dlog(dexp(x)+dexp(-x))
717 facT(2)=licznik/dlog(dexp(x2)+dexp(-x2))
718 facT(3)=licznik/dlog(dexp(x3)+dexp(-x3))
719 facT(4)=licznik/dlog(dexp(x4)+dexp(-x4))
720 facT(5)=licznik/dlog(dexp(x5)+dexp(-x5))
722 !#if defined(WHAM_RUN) || defined(CLUSTER)
724 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
732 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
733 write (*,*) "Wrong RESCALE_MODE",rescale_mode
735 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
739 welec=weights(3)*fact(1)
740 wcorr=weights(4)*fact(3)
741 wcorr5=weights(5)*fact(4)
742 wcorr6=weights(6)*fact(5)
743 wel_loc=weights(7)*fact(2)
744 wturn3=weights(8)*fact(2)
745 wturn4=weights(9)*fact(3)
746 wturn6=weights(10)*fact(5)
747 wtor=weights(13)*fact(1)
748 wtor_d=weights(14)*fact(2)
749 wsccor=weights(21)*fact(1)
752 end subroutine rescale_weights
753 !-----------------------------------------------------------------------------
754 subroutine enerprint(energia)
755 ! implicit real*8 (a-h,o-z)
756 ! include 'DIMENSIONS'
757 ! include 'COMMON.IOUNITS'
758 ! include 'COMMON.FFIELD'
759 ! include 'COMMON.SBRIDGE'
760 ! include 'COMMON.MD'
761 real(kind=8) :: energia(0:n_ene)
763 real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
764 real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
765 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor
771 evdw2=energia(2)+energia(18)
783 eello_turn3=energia(8)
784 eello_turn4=energia(9)
785 eello_turn6=energia(10)
791 edihcnstr=energia(19)
796 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
797 estr,wbond,ebe,wang,&
798 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
800 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
801 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,&
804 10 format (/'Virtual-chain energies:'// &
805 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
806 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
807 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
808 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ &
809 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
810 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
811 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
812 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
813 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
814 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
815 ' (SS bridges & dist. cnstr.)'/ &
816 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
817 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
818 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
819 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
820 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
821 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
822 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
823 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
824 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
825 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
826 'UCONST= ',1pE16.6,' (Constraint energy)'/ &
827 'ETOT= ',1pE16.6,' (total)')
829 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
830 estr,wbond,ebe,wang,&
831 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
833 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
834 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
836 10 format (/'Virtual-chain energies:'// &
837 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
838 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
839 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
840 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
841 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
842 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
843 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
844 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
845 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
846 ' (SS bridges & dist. cnstr.)'/ &
847 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
848 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
849 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
850 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
851 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
852 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
853 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
854 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
855 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
856 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
857 'UCONST=',1pE16.6,' (Constraint energy)'/ &
858 'ETOT= ',1pE16.6,' (total)')
861 end subroutine enerprint
862 !-----------------------------------------------------------------------------
865 ! This subroutine calculates the interaction energy of nonbonded side chains
866 ! assuming the LJ potential of interaction.
868 ! implicit real*8 (a-h,o-z)
869 ! include 'DIMENSIONS'
870 real(kind=8),parameter :: accur=1.0d-10
871 ! include 'COMMON.GEO'
872 ! include 'COMMON.VAR'
873 ! include 'COMMON.LOCAL'
874 ! include 'COMMON.CHAIN'
875 ! include 'COMMON.DERIV'
876 ! include 'COMMON.INTERACT'
877 ! include 'COMMON.TORSION'
878 ! include 'COMMON.SBRIDGE'
879 ! include 'COMMON.NAMES'
880 ! include 'COMMON.IOUNITS'
881 ! include 'COMMON.CONTACTS'
882 real(kind=8),dimension(3) :: gg
885 integer :: i,itypi,iint,j,itypi1,itypj,k
886 real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
887 real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
888 real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
890 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
892 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
893 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
894 ! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
895 ! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
899 if (itypi.eq.ntyp1) cycle
900 itypi1=iabs(itype(i+1))
907 ! Calculate SC interaction energy.
910 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
911 !d & 'iend=',iend(i,iint)
912 do j=istart(i,iint),iend(i,iint)
914 if (itypj.eq.ntyp1) cycle
918 ! Change 12/1/95 to calculate four-body interactions
919 rij=xj*xj+yj*yj+zj*zj
921 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
922 eps0ij=eps(itypi,itypj)
924 e1=fac*fac*aa(itypi,itypj)
925 e2=fac*bb(itypi,itypj)
927 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
928 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
929 !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
930 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
931 !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
932 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
935 ! Calculate the components of the gradient in DC and X
937 fac=-rrij*(e1+evdwij)
942 gvdwx(k,i)=gvdwx(k,i)-gg(k)
943 gvdwx(k,j)=gvdwx(k,j)+gg(k)
944 gvdwc(k,i)=gvdwc(k,i)-gg(k)
945 gvdwc(k,j)=gvdwc(k,j)+gg(k)
949 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
953 ! 12/1/95, revised on 5/20/97
955 ! Calculate the contact function. The ith column of the array JCONT will
956 ! contain the numbers of atoms that make contacts with the atom I (of numbers
957 ! greater than I). The arrays FACONT and GACONT will contain the values of
958 ! the contact function and its derivative.
960 ! Uncomment next line, if the correlation interactions include EVDW explicitly.
961 ! if (j.gt.i+1 .and. evdwij.le.0.0D0) then
962 ! Uncomment next line, if the correlation interactions are contact function only
963 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
965 sigij=sigma(itypi,itypj)
966 r0ij=rs0(itypi,itypj)
968 ! Check whether the SC's are not too far to make a contact.
971 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
972 ! Add a new contact, if the SC's are close enough, but not too close (r<sigma).
974 if (fcont.gt.0.0D0) then
975 ! If the SC-SC distance if close to sigma, apply spline.
976 !Adam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
977 !Adam & fcont1,fprimcont1)
978 !Adam fcont1=1.0d0-fcont1
979 !Adam if (fcont1.gt.0.0d0) then
980 !Adam fprimcont=fprimcont*fcont1+fcont*fprimcont1
981 !Adam fcont=fcont*fcont1
983 ! Uncomment following 4 lines to have the geometric average of the epsilon0's
984 !ga eps0ij=1.0d0/dsqrt(eps0ij)
986 !ga gg(k)=gg(k)*eps0ij
988 !ga eps0ij=-evdwij*eps0ij
989 ! Uncomment for AL's type of SC correlation interactions.
991 num_conti=num_conti+1
993 facont(num_conti,i)=fcont*eps0ij
994 fprimcont=eps0ij*fprimcont/rij
996 !Adam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
997 !Adam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
998 !Adam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
999 ! Uncomment following 3 lines for Skolnick's type of SC correlation.
1000 gacont(1,num_conti,i)=-fprimcont*xj
1001 gacont(2,num_conti,i)=-fprimcont*yj
1002 gacont(3,num_conti,i)=-fprimcont*zj
1003 !d write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1004 !d write (iout,'(2i3,3f10.5)')
1005 !d & i,j,(gacont(kk,num_conti,i),kk=1,3)
1011 num_cont(i)=num_conti
1015 gvdwc(j,i)=expon*gvdwc(j,i)
1016 gvdwx(j,i)=expon*gvdwx(j,i)
1019 !******************************************************************************
1023 ! To save time, the factor of EXPON has been extracted from ALL components
1024 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
1027 !******************************************************************************
1030 !-----------------------------------------------------------------------------
1031 subroutine eljk(evdw)
1033 ! This subroutine calculates the interaction energy of nonbonded side chains
1034 ! assuming the LJK potential of interaction.
1036 ! implicit real*8 (a-h,o-z)
1037 ! include 'DIMENSIONS'
1038 ! include 'COMMON.GEO'
1039 ! include 'COMMON.VAR'
1040 ! include 'COMMON.LOCAL'
1041 ! include 'COMMON.CHAIN'
1042 ! include 'COMMON.DERIV'
1043 ! include 'COMMON.INTERACT'
1044 ! include 'COMMON.IOUNITS'
1045 ! include 'COMMON.NAMES'
1046 real(kind=8),dimension(3) :: gg
1049 integer :: i,iint,j,itypi,itypi1,k,itypj
1050 real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
1051 real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
1053 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1055 do i=iatsc_s,iatsc_e
1056 itypi=iabs(itype(i))
1057 if (itypi.eq.ntyp1) cycle
1058 itypi1=iabs(itype(i+1))
1063 ! Calculate SC interaction energy.
1065 do iint=1,nint_gr(i)
1066 do j=istart(i,iint),iend(i,iint)
1067 itypj=iabs(itype(j))
1068 if (itypj.eq.ntyp1) cycle
1072 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1073 fac_augm=rrij**expon
1074 e_augm=augm(itypi,itypj)*fac_augm
1075 r_inv_ij=dsqrt(rrij)
1077 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1078 fac=r_shift_inv**expon
1079 e1=fac*fac*aa(itypi,itypj)
1080 e2=fac*bb(itypi,itypj)
1082 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1083 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1084 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1085 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1086 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1087 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1088 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1091 ! Calculate the components of the gradient in DC and X
1093 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1098 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1099 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1100 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1101 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1105 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1113 gvdwc(j,i)=expon*gvdwc(j,i)
1114 gvdwx(j,i)=expon*gvdwx(j,i)
1119 !-----------------------------------------------------------------------------
1120 subroutine ebp(evdw)
1122 ! This subroutine calculates the interaction energy of nonbonded side chains
1123 ! assuming the Berne-Pechukas potential of interaction.
1127 ! implicit real*8 (a-h,o-z)
1128 ! include 'DIMENSIONS'
1129 ! include 'COMMON.GEO'
1130 ! include 'COMMON.VAR'
1131 ! include 'COMMON.LOCAL'
1132 ! include 'COMMON.CHAIN'
1133 ! include 'COMMON.DERIV'
1134 ! include 'COMMON.NAMES'
1135 ! include 'COMMON.INTERACT'
1136 ! include 'COMMON.IOUNITS'
1137 ! include 'COMMON.CALC'
1139 !el integer :: icall
1140 !el common /srutu/ icall
1141 ! double precision rrsave(maxdim)
1144 integer :: iint,itypi,itypi1,itypj
1145 real(kind=8) :: rrij,xi,yi,zi
1146 real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
1148 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1150 ! if (icall.eq.0) then
1156 do i=iatsc_s,iatsc_e
1157 itypi=iabs(itype(i))
1158 if (itypi.eq.ntyp1) cycle
1159 itypi1=iabs(itype(i+1))
1163 dxi=dc_norm(1,nres+i)
1164 dyi=dc_norm(2,nres+i)
1165 dzi=dc_norm(3,nres+i)
1166 ! dsci_inv=dsc_inv(itypi)
1167 dsci_inv=vbld_inv(i+nres)
1169 ! Calculate SC interaction energy.
1171 do iint=1,nint_gr(i)
1172 do j=istart(i,iint),iend(i,iint)
1174 itypj=iabs(itype(j))
1175 if (itypj.eq.ntyp1) cycle
1176 ! dscj_inv=dsc_inv(itypj)
1177 dscj_inv=vbld_inv(j+nres)
1178 chi1=chi(itypi,itypj)
1179 chi2=chi(itypj,itypi)
1186 alf12=0.5D0*(alf1+alf2)
1187 ! For diagnostics only!!!
1200 dxj=dc_norm(1,nres+j)
1201 dyj=dc_norm(2,nres+j)
1202 dzj=dc_norm(3,nres+j)
1203 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1204 !d if (icall.eq.0) then
1210 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
1212 ! Calculate whole angle-dependent part of epsilon and contributions
1213 ! to its derivatives
1214 fac=(rrij*sigsq)**expon2
1215 e1=fac*fac*aa(itypi,itypj)
1216 e2=fac*bb(itypi,itypj)
1217 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1218 eps2der=evdwij*eps3rt
1219 eps3der=evdwij*eps2rt
1220 evdwij=evdwij*eps2rt*eps3rt
1223 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1224 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1225 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1226 !d & restyp(itypi),i,restyp(itypj),j,
1227 !d & epsi,sigm,chi1,chi2,chip1,chip2,
1228 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1229 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
1232 ! Calculate gradient components.
1233 e1=e1*eps1*eps2rt**2*eps3rt**2
1234 fac=-expon*(e1+evdwij)
1237 ! Calculate radial part of the gradient
1241 ! Calculate the angular part of the gradient and sum add the contributions
1242 ! to the appropriate components of the Cartesian gradient.
1250 !-----------------------------------------------------------------------------
1251 subroutine egb(evdw)
1253 ! This subroutine calculates the interaction energy of nonbonded side chains
1254 ! assuming the Gay-Berne potential of interaction.
1257 ! implicit real*8 (a-h,o-z)
1258 ! include 'DIMENSIONS'
1259 ! include 'COMMON.GEO'
1260 ! include 'COMMON.VAR'
1261 ! include 'COMMON.LOCAL'
1262 ! include 'COMMON.CHAIN'
1263 ! include 'COMMON.DERIV'
1264 ! include 'COMMON.NAMES'
1265 ! include 'COMMON.INTERACT'
1266 ! include 'COMMON.IOUNITS'
1267 ! include 'COMMON.CALC'
1268 ! include 'COMMON.CONTROL'
1269 ! include 'COMMON.SBRIDGE'
1272 integer :: iint,itypi,itypi1,itypj
1273 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
1274 real(kind=8) :: evdw,sig0ij
1276 !cccc energy_dec=.false.
1277 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1280 ! if (icall.eq.0) lprn=.false.
1282 do i=iatsc_s,iatsc_e
1283 itypi=iabs(itype(i))
1284 if (itypi.eq.ntyp1) cycle
1285 itypi1=iabs(itype(i+1))
1289 dxi=dc_norm(1,nres+i)
1290 dyi=dc_norm(2,nres+i)
1291 dzi=dc_norm(3,nres+i)
1292 ! dsci_inv=dsc_inv(itypi)
1293 dsci_inv=vbld_inv(i+nres)
1294 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1295 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1297 ! Calculate SC interaction energy.
1299 do iint=1,nint_gr(i)
1300 do j=istart(i,iint),iend(i,iint)
1301 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1302 call dyn_ssbond_ene(i,j,evdwij)
1304 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1305 'evdw',i,j,evdwij,' ss'
1306 ! if (energy_dec) write (iout,*) &
1307 ! 'evdw',i,j,evdwij,' ss'
1310 itypj=iabs(itype(j))
1311 if (itypj.eq.ntyp1) cycle
1312 ! dscj_inv=dsc_inv(itypj)
1313 dscj_inv=vbld_inv(j+nres)
1314 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,&
1315 ! 1.0d0/vbld(j+nres) !d
1316 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1317 sig0ij=sigma(itypi,itypj)
1318 chi1=chi(itypi,itypj)
1319 chi2=chi(itypj,itypi)
1326 alf12=0.5D0*(alf1+alf2)
1327 ! For diagnostics only!!!
1340 dxj=dc_norm(1,nres+j)
1341 dyj=dc_norm(2,nres+j)
1342 dzj=dc_norm(3,nres+j)
1343 ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1344 ! write (iout,*) "j",j," dc_norm",& !d
1345 ! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1346 ! write(iout,*)"rrij ",rrij
1347 ! write(iout,*)"xj yj zj ", xj, yj, zj
1348 ! write(iout,*)"xi yi zi ", xi, yi, zi
1349 ! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
1350 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1352 ! Calculate angle-dependent terms of energy and contributions to their
1356 sig=sig0ij*dsqrt(sigsq)
1357 rij_shift=1.0D0/rij-sig+sig0ij
1358 ! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,&
1360 ! for diagnostics; uncomment
1361 ! rij_shift=1.2*sig0ij
1362 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1363 if (rij_shift.le.0.0D0) then
1365 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1366 !d & restyp(itypi),i,restyp(itypj),j,
1367 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1371 !---------------------------------------------------------------
1372 rij_shift=1.0D0/rij_shift
1373 fac=rij_shift**expon
1374 e1=fac*fac*aa(itypi,itypj)
1375 e2=fac*bb(itypi,itypj)
1376 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1377 eps2der=evdwij*eps3rt
1378 eps3der=evdwij*eps2rt
1379 ! write(iout,*)"aa, bb ",aa(:,:),bb(:,:)
1380 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d
1381 ! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d
1382 evdwij=evdwij*eps2rt*eps3rt
1385 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1386 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1387 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1388 restyp(itypi),i,restyp(itypj),j, &
1389 epsi,sigm,chi1,chi2,chip1,chip2, &
1390 eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
1391 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
1395 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
1396 'evdw',i,j,evdwij !,"egb"
1397 ! if (energy_dec) write (iout,*) &
1400 ! Calculate gradient components.
1401 e1=e1*eps1*eps2rt**2*eps3rt**2
1402 fac=-expon*(e1+evdwij)*rij_shift
1406 ! Calculate the radial part of the gradient
1410 ! Calculate angular part of the gradient.
1416 ! write (iout,*) "Number of loop steps in EGB:",ind
1417 !ccc energy_dec=.false.
1420 !-----------------------------------------------------------------------------
1421 subroutine egbv(evdw)
1423 ! This subroutine calculates the interaction energy of nonbonded side chains
1424 ! assuming the Gay-Berne-Vorobjev potential of interaction.
1428 ! implicit real*8 (a-h,o-z)
1429 ! include 'DIMENSIONS'
1430 ! include 'COMMON.GEO'
1431 ! include 'COMMON.VAR'
1432 ! include 'COMMON.LOCAL'
1433 ! include 'COMMON.CHAIN'
1434 ! include 'COMMON.DERIV'
1435 ! include 'COMMON.NAMES'
1436 ! include 'COMMON.INTERACT'
1437 ! include 'COMMON.IOUNITS'
1438 ! include 'COMMON.CALC'
1440 !el integer :: icall
1441 !el common /srutu/ icall
1444 integer :: iint,itypi,itypi1,itypj
1445 real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
1446 real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
1448 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1451 ! if (icall.eq.0) lprn=.true.
1453 do i=iatsc_s,iatsc_e
1454 itypi=iabs(itype(i))
1455 if (itypi.eq.ntyp1) cycle
1456 itypi1=iabs(itype(i+1))
1460 dxi=dc_norm(1,nres+i)
1461 dyi=dc_norm(2,nres+i)
1462 dzi=dc_norm(3,nres+i)
1463 ! dsci_inv=dsc_inv(itypi)
1464 dsci_inv=vbld_inv(i+nres)
1466 ! Calculate SC interaction energy.
1468 do iint=1,nint_gr(i)
1469 do j=istart(i,iint),iend(i,iint)
1471 itypj=iabs(itype(j))
1472 if (itypj.eq.ntyp1) cycle
1473 ! dscj_inv=dsc_inv(itypj)
1474 dscj_inv=vbld_inv(j+nres)
1475 sig0ij=sigma(itypi,itypj)
1476 r0ij=r0(itypi,itypj)
1477 chi1=chi(itypi,itypj)
1478 chi2=chi(itypj,itypi)
1485 alf12=0.5D0*(alf1+alf2)
1486 ! For diagnostics only!!!
1499 dxj=dc_norm(1,nres+j)
1500 dyj=dc_norm(2,nres+j)
1501 dzj=dc_norm(3,nres+j)
1502 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1504 ! Calculate angle-dependent terms of energy and contributions to their
1508 sig=sig0ij*dsqrt(sigsq)
1509 rij_shift=1.0D0/rij-sig+r0ij
1510 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1511 if (rij_shift.le.0.0D0) then
1516 !---------------------------------------------------------------
1517 rij_shift=1.0D0/rij_shift
1518 fac=rij_shift**expon
1519 e1=fac*fac*aa(itypi,itypj)
1520 e2=fac*bb(itypi,itypj)
1521 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1522 eps2der=evdwij*eps3rt
1523 eps3der=evdwij*eps2rt
1524 fac_augm=rrij**expon
1525 e_augm=augm(itypi,itypj)*fac_augm
1526 evdwij=evdwij*eps2rt*eps3rt
1527 evdw=evdw+evdwij+e_augm
1529 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1530 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1531 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1532 restyp(itypi),i,restyp(itypj),j,&
1533 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
1534 chi1,chi2,chip1,chip2,&
1535 eps1,eps2rt**2,eps3rt**2,&
1536 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
1539 ! Calculate gradient components.
1540 e1=e1*eps1*eps2rt**2*eps3rt**2
1541 fac=-expon*(e1+evdwij)*rij_shift
1543 fac=rij*fac-2*expon*rrij*e_augm
1544 ! Calculate the radial part of the gradient
1548 ! Calculate angular part of the gradient.
1554 !-----------------------------------------------------------------------------
1555 !el subroutine sc_angular in module geometry
1556 !-----------------------------------------------------------------------------
1557 subroutine e_softsphere(evdw)
1559 ! This subroutine calculates the interaction energy of nonbonded side chains
1560 ! assuming the LJ potential of interaction.
1562 ! implicit real*8 (a-h,o-z)
1563 ! include 'DIMENSIONS'
1564 real(kind=8),parameter :: accur=1.0d-10
1565 ! include 'COMMON.GEO'
1566 ! include 'COMMON.VAR'
1567 ! include 'COMMON.LOCAL'
1568 ! include 'COMMON.CHAIN'
1569 ! include 'COMMON.DERIV'
1570 ! include 'COMMON.INTERACT'
1571 ! include 'COMMON.TORSION'
1572 ! include 'COMMON.SBRIDGE'
1573 ! include 'COMMON.NAMES'
1574 ! include 'COMMON.IOUNITS'
1575 ! include 'COMMON.CONTACTS'
1576 real(kind=8),dimension(3) :: gg
1577 !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1579 integer :: i,iint,j,itypi,itypi1,itypj,k
1580 real(kind=8) :: evdw,xj,yj,zj,xi,yi,zi,rij,r0ij,r0ijsq,evdwij
1584 do i=iatsc_s,iatsc_e
1585 itypi=iabs(itype(i))
1586 if (itypi.eq.ntyp1) cycle
1587 itypi1=iabs(itype(i+1))
1592 ! Calculate SC interaction energy.
1594 do iint=1,nint_gr(i)
1595 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1596 !d & 'iend=',iend(i,iint)
1597 do j=istart(i,iint),iend(i,iint)
1598 itypj=iabs(itype(j))
1599 if (itypj.eq.ntyp1) cycle
1603 rij=xj*xj+yj*yj+zj*zj
1604 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1605 r0ij=r0(itypi,itypj)
1607 ! print *,i,j,r0ij,dsqrt(rij)
1608 if (rij.lt.r0ijsq) then
1609 evdwij=0.25d0*(rij-r0ijsq)**2
1617 ! Calculate the components of the gradient in DC and X
1623 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1624 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1625 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1626 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1630 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1637 end subroutine e_softsphere
1638 !-----------------------------------------------------------------------------
1639 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1641 ! Soft-sphere potential of p-p interaction
1643 ! implicit real*8 (a-h,o-z)
1644 ! include 'DIMENSIONS'
1645 ! include 'COMMON.CONTROL'
1646 ! include 'COMMON.IOUNITS'
1647 ! include 'COMMON.GEO'
1648 ! include 'COMMON.VAR'
1649 ! include 'COMMON.LOCAL'
1650 ! include 'COMMON.CHAIN'
1651 ! include 'COMMON.DERIV'
1652 ! include 'COMMON.INTERACT'
1653 ! include 'COMMON.CONTACTS'
1654 ! include 'COMMON.TORSION'
1655 ! include 'COMMON.VECTORS'
1656 ! include 'COMMON.FFIELD'
1657 real(kind=8),dimension(3) :: ggg
1658 !d write(iout,*) 'In EELEC_soft_sphere'
1660 integer :: i,j,k,num_conti,iteli,itelj
1661 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
1662 real(kind=8) :: dxi,dyi,dzi,xmedi,ymedi,zmedi,r0ij,r0ijsq
1663 real(kind=8) :: dxj,dyj,dzj,xj,yj,zj,rij,evdw1ij,fac
1671 do i=iatel_s,iatel_e
1672 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1676 xmedi=c(1,i)+0.5d0*dxi
1677 ymedi=c(2,i)+0.5d0*dyi
1678 zmedi=c(3,i)+0.5d0*dzi
1680 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1681 do j=ielstart(i),ielend(i)
1682 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1686 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1687 r0ij=rpp(iteli,itelj)
1692 xj=c(1,j)+0.5D0*dxj-xmedi
1693 yj=c(2,j)+0.5D0*dyj-ymedi
1694 zj=c(3,j)+0.5D0*dzj-zmedi
1695 rij=xj*xj+yj*yj+zj*zj
1696 if (rij.lt.r0ijsq) then
1697 evdw1ij=0.25d0*(rij-r0ijsq)**2
1705 ! Calculate contributions to the Cartesian gradient.
1711 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1712 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1715 ! Loop over residues i+1 thru j-1.
1719 !grad gelc(l,k)=gelc(l,k)+ggg(l)
1724 !grad do i=nnt,nct-1
1726 !grad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1728 !grad do j=i+1,nct-1
1730 !grad gelc(k,i)=gelc(k,i)+gelc(k,j)
1735 end subroutine eelec_soft_sphere
1736 !-----------------------------------------------------------------------------
1737 subroutine vec_and_deriv
1738 ! implicit real*8 (a-h,o-z)
1739 ! include 'DIMENSIONS'
1743 ! include 'COMMON.IOUNITS'
1744 ! include 'COMMON.GEO'
1745 ! include 'COMMON.VAR'
1746 ! include 'COMMON.LOCAL'
1747 ! include 'COMMON.CHAIN'
1748 ! include 'COMMON.VECTORS'
1749 ! include 'COMMON.SETUP'
1750 ! include 'COMMON.TIME1'
1751 real(kind=8),dimension(3,3,2) :: uyder,uzder
1752 real(kind=8),dimension(2) :: vbld_inv_temp
1753 ! Compute the local reference systems. For reference system (i), the
1754 ! X-axis points from CA(i) to CA(i+1), the Y axis is in the
1755 ! CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1758 real(kind=8) :: facy,fac,costh
1761 do i=ivec_start,ivec_end
1765 if (i.eq.nres-1) then
1766 ! Case of the last full residue
1767 ! Compute the Z-axis
1768 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1769 costh=dcos(pi-theta(nres))
1770 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1774 ! Compute the derivatives of uz
1776 uzder(2,1,1)=-dc_norm(3,i-1)
1777 uzder(3,1,1)= dc_norm(2,i-1)
1778 uzder(1,2,1)= dc_norm(3,i-1)
1780 uzder(3,2,1)=-dc_norm(1,i-1)
1781 uzder(1,3,1)=-dc_norm(2,i-1)
1782 uzder(2,3,1)= dc_norm(1,i-1)
1785 uzder(2,1,2)= dc_norm(3,i)
1786 uzder(3,1,2)=-dc_norm(2,i)
1787 uzder(1,2,2)=-dc_norm(3,i)
1789 uzder(3,2,2)= dc_norm(1,i)
1790 uzder(1,3,2)= dc_norm(2,i)
1791 uzder(2,3,2)=-dc_norm(1,i)
1793 ! Compute the Y-axis
1796 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1798 ! Compute the derivatives of uy
1801 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) &
1802 -dc_norm(k,i)*dc_norm(j,i-1)
1803 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1805 uyder(j,j,1)=uyder(j,j,1)-costh
1806 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1811 uygrad(l,k,j,i)=uyder(l,k,j)
1812 uzgrad(l,k,j,i)=uzder(l,k,j)
1816 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1817 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1818 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1819 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1822 ! Compute the Z-axis
1823 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1824 costh=dcos(pi-theta(i+2))
1825 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1829 ! Compute the derivatives of uz
1831 uzder(2,1,1)=-dc_norm(3,i+1)
1832 uzder(3,1,1)= dc_norm(2,i+1)
1833 uzder(1,2,1)= dc_norm(3,i+1)
1835 uzder(3,2,1)=-dc_norm(1,i+1)
1836 uzder(1,3,1)=-dc_norm(2,i+1)
1837 uzder(2,3,1)= dc_norm(1,i+1)
1840 uzder(2,1,2)= dc_norm(3,i)
1841 uzder(3,1,2)=-dc_norm(2,i)
1842 uzder(1,2,2)=-dc_norm(3,i)
1844 uzder(3,2,2)= dc_norm(1,i)
1845 uzder(1,3,2)= dc_norm(2,i)
1846 uzder(2,3,2)=-dc_norm(1,i)
1848 ! Compute the Y-axis
1851 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1853 ! Compute the derivatives of uy
1856 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) &
1857 -dc_norm(k,i)*dc_norm(j,i+1)
1858 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1860 uyder(j,j,1)=uyder(j,j,1)-costh
1861 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1866 uygrad(l,k,j,i)=uyder(l,k,j)
1867 uzgrad(l,k,j,i)=uzder(l,k,j)
1871 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1872 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1873 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1874 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1878 vbld_inv_temp(1)=vbld_inv(i+1)
1879 if (i.lt.nres-1) then
1880 vbld_inv_temp(2)=vbld_inv(i+2)
1882 vbld_inv_temp(2)=vbld_inv(i)
1887 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1888 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1893 #if defined(PARVEC) && defined(MPI)
1894 if (nfgtasks1.gt.1) then
1896 ! print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
1897 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
1898 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
1899 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),&
1900 MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
1902 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),&
1903 MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
1905 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),&
1906 ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),&
1907 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
1908 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),&
1909 ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),&
1910 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
1911 time_gather=time_gather+MPI_Wtime()-time00
1913 ! if (fg_rank.eq.0) then
1914 ! write (iout,*) "Arrays UY and UZ"
1916 ! write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
1922 end subroutine vec_and_deriv
1923 !-----------------------------------------------------------------------------
1924 subroutine check_vecgrad
1925 ! implicit real*8 (a-h,o-z)
1926 ! include 'DIMENSIONS'
1927 ! include 'COMMON.IOUNITS'
1928 ! include 'COMMON.GEO'
1929 ! include 'COMMON.VAR'
1930 ! include 'COMMON.LOCAL'
1931 ! include 'COMMON.CHAIN'
1932 ! include 'COMMON.VECTORS'
1933 real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
1934 real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
1935 real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
1936 real(kind=8),dimension(3) :: erij
1937 real(kind=8) :: delta=1.0d-7
1943 !rc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1944 !rc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1945 !rc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1946 !d write(iout,'(2i5,2(3f10.5,5x))') i,1,
1947 !d & (dc_norm(if90,i),if90=1,3)
1948 !d write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1949 !d write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1950 !d write(iout,'(a)')
1956 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1957 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1970 !d write (iout,*) 'i=',i
1972 erij(k)=dc_norm(k,i)
1976 dc_norm(k,i)=erij(k)
1978 dc_norm(j,i)=dc_norm(j,i)+delta
1979 ! fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1981 ! dc_norm(k,i)=dc_norm(k,i)/fac
1983 ! write (iout,*) (dc_norm(k,i),k=1,3)
1984 ! write (iout,*) (erij(k),k=1,3)
1987 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1988 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1989 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1990 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1992 ! write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1993 ! & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1994 ! & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1997 dc_norm(k,i)=erij(k)
2000 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2001 !d & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2002 !d & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2003 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2004 !d & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2005 !d & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2006 !d write (iout,'(a)')
2010 end subroutine check_vecgrad
2011 !-----------------------------------------------------------------------------
2012 subroutine set_matrices
2013 ! implicit real*8 (a-h,o-z)
2014 ! include 'DIMENSIONS'
2017 ! include "COMMON.SETUP"
2019 integer :: status(MPI_STATUS_SIZE)
2021 ! include 'COMMON.IOUNITS'
2022 ! include 'COMMON.GEO'
2023 ! include 'COMMON.VAR'
2024 ! include 'COMMON.LOCAL'
2025 ! include 'COMMON.CHAIN'
2026 ! include 'COMMON.DERIV'
2027 ! include 'COMMON.INTERACT'
2028 ! include 'COMMON.CONTACTS'
2029 ! include 'COMMON.TORSION'
2030 ! include 'COMMON.VECTORS'
2031 ! include 'COMMON.FFIELD'
2032 real(kind=8) :: auxvec(2),auxmat(2,2)
2033 integer :: i,iti1,iti,k,l
2034 real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2
2037 ! Compute the virtual-bond-torsional-angle dependent quantities needed
2038 ! to calculate the el-loc multibody terms of various order.
2042 do i=ivec_start+2,ivec_end+2
2046 if (i .lt. nres+1) then
2083 if (i .gt. 3 .and. i .lt. nres+1) then
2084 obrot_der(1,i-2)=-sin1
2085 obrot_der(2,i-2)= cos1
2086 Ugder(1,1,i-2)= sin1
2087 Ugder(1,2,i-2)=-cos1
2088 Ugder(2,1,i-2)=-cos1
2089 Ugder(2,2,i-2)=-sin1
2092 obrot2_der(1,i-2)=-dwasin2
2093 obrot2_der(2,i-2)= dwacos2
2094 Ug2der(1,1,i-2)= dwasin2
2095 Ug2der(1,2,i-2)=-dwacos2
2096 Ug2der(2,1,i-2)=-dwacos2
2097 Ug2der(2,2,i-2)=-dwasin2
2099 obrot_der(1,i-2)=0.0d0
2100 obrot_der(2,i-2)=0.0d0
2101 Ugder(1,1,i-2)=0.0d0
2102 Ugder(1,2,i-2)=0.0d0
2103 Ugder(2,1,i-2)=0.0d0
2104 Ugder(2,2,i-2)=0.0d0
2105 obrot2_der(1,i-2)=0.0d0
2106 obrot2_der(2,i-2)=0.0d0
2107 Ug2der(1,1,i-2)=0.0d0
2108 Ug2der(1,2,i-2)=0.0d0
2109 Ug2der(2,1,i-2)=0.0d0
2110 Ug2der(2,2,i-2)=0.0d0
2112 ! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2113 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2114 iti = itortyp(itype(i-2))
2118 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2119 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2120 iti1 = itortyp(itype(i-1))
2124 !d write (iout,*) '*******i',i,' iti1',iti
2125 !d write (iout,*) 'b1',b1(:,iti)
2126 !d write (iout,*) 'b2',b2(:,iti)
2127 !d write (iout,*) 'Ug',Ug(:,:,i-2)
2128 ! if (i .gt. iatel_s+2) then
2129 if (i .gt. nnt+2) then
2130 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2131 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2132 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2134 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2135 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2136 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2137 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2138 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2149 DtUg2(l,k,i-2)=0.0d0
2153 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2154 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2156 muder(k,i-2)=Ub2der(k,i-2)
2158 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2159 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2160 if (itype(i-1).le.ntyp) then
2161 iti1 = itortyp(itype(i-1))
2169 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2171 ! if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
2172 ! if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,iti1)
2173 ! if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
2174 !d write (iout,*) 'mu1',mu1(:,i-2)
2175 !d write (iout,*) 'mu2',mu2(:,i-2)
2176 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2178 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2179 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2180 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2181 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2182 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2183 ! Vectors and matrices dependent on a single virtual-bond dihedral.
2184 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2185 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2186 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2187 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2188 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2189 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2190 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2191 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2192 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2195 ! Matrices dependent on two consecutive virtual-bond dihedrals.
2196 ! The order of matrices is from left to right.
2197 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2199 ! do i=max0(ivec_start,2),ivec_end
2201 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2202 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2203 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2204 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2205 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2206 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2207 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2208 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2211 #if defined(MPI) && defined(PARMAT)
2213 ! if (fg_rank.eq.0) then
2214 write (iout,*) "Arrays UG and UGDER before GATHER"
2216 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2217 ((ug(l,k,i),l=1,2),k=1,2),&
2218 ((ugder(l,k,i),l=1,2),k=1,2)
2220 write (iout,*) "Arrays UG2 and UG2DER"
2222 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2223 ((ug2(l,k,i),l=1,2),k=1,2),&
2224 ((ug2der(l,k,i),l=1,2),k=1,2)
2226 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2228 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2229 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2230 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2232 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2234 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2235 costab(i),sintab(i),costab2(i),sintab2(i)
2237 write (iout,*) "Array MUDER"
2239 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2243 if (nfgtasks.gt.1) then
2245 ! write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2246 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2247 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2249 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),&
2250 MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2252 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),&
2253 MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2255 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),&
2256 MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2258 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),&
2259 MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2261 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),&
2262 MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2264 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),&
2265 MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2267 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),&
2268 MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),&
2269 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2270 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),&
2271 MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),&
2272 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2273 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),&
2274 MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),&
2275 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2276 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),&
2277 MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),&
2278 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2279 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2281 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),&
2282 MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2284 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),&
2285 MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2287 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),&
2288 MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2290 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),&
2291 MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2293 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),&
2294 MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2296 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),&
2297 ivec_count(fg_rank1),&
2298 MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2300 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),&
2301 MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2303 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),&
2304 MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2306 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),&
2307 MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2309 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),&
2310 MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2312 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),&
2313 MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2315 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),&
2316 MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2318 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),&
2319 MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2321 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),&
2322 ivec_count(fg_rank1),&
2323 MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2325 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),&
2326 MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2328 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),&
2329 MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2331 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),&
2332 MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2334 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),&
2335 MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2337 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),&
2338 ivec_count(fg_rank1),&
2339 MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2341 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),&
2342 ivec_count(fg_rank1),&
2343 MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2345 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),&
2346 ivec_count(fg_rank1),&
2347 MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2348 MPI_MAT2,FG_COMM1,IERR)
2349 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),&
2350 ivec_count(fg_rank1),&
2351 MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2352 MPI_MAT2,FG_COMM1,IERR)
2355 ! Passes matrix info through the ring
2358 if (irecv.lt.0) irecv=nfgtasks1-1
2361 if (inext.ge.nfgtasks1) inext=0
2363 ! write (iout,*) "isend",isend," irecv",irecv
2365 lensend=lentyp(isend)
2366 lenrecv=lentyp(irecv)
2367 ! write (iout,*) "lensend",lensend," lenrecv",lenrecv
2368 ! call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2369 ! & MPI_ROTAT1(lensend),inext,2200+isend,
2370 ! & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2371 ! & iprev,2200+irecv,FG_COMM,status,IERR)
2372 ! write (iout,*) "Gather ROTAT1"
2374 ! call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2375 ! & MPI_ROTAT2(lensend),inext,3300+isend,
2376 ! & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2377 ! & iprev,3300+irecv,FG_COMM,status,IERR)
2378 ! write (iout,*) "Gather ROTAT2"
2380 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,&
2381 MPI_ROTAT_OLD(lensend),inext,4400+isend,&
2382 costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),&
2383 iprev,4400+irecv,FG_COMM,status,IERR)
2384 ! write (iout,*) "Gather ROTAT_OLD"
2386 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,&
2387 MPI_PRECOMP11(lensend),inext,5500+isend,&
2388 mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),&
2389 iprev,5500+irecv,FG_COMM,status,IERR)
2390 ! write (iout,*) "Gather PRECOMP11"
2392 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,&
2393 MPI_PRECOMP12(lensend),inext,6600+isend,&
2394 Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),&
2395 iprev,6600+irecv,FG_COMM,status,IERR)
2396 ! write (iout,*) "Gather PRECOMP12"
2398 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2400 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,&
2401 MPI_ROTAT2(lensend),inext,7700+isend,&
2402 ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),&
2403 iprev,7700+irecv,FG_COMM,status,IERR)
2404 ! write (iout,*) "Gather PRECOMP21"
2406 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,&
2407 MPI_PRECOMP22(lensend),inext,8800+isend,&
2408 EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),&
2409 iprev,8800+irecv,FG_COMM,status,IERR)
2410 ! write (iout,*) "Gather PRECOMP22"
2412 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,&
2413 MPI_PRECOMP23(lensend),inext,9900+isend,&
2414 Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,&
2415 MPI_PRECOMP23(lenrecv),&
2416 iprev,9900+irecv,FG_COMM,status,IERR)
2417 ! write (iout,*) "Gather PRECOMP23"
2422 if (irecv.lt.0) irecv=nfgtasks1-1
2425 time_gather=time_gather+MPI_Wtime()-time00
2428 ! if (fg_rank.eq.0) then
2429 write (iout,*) "Arrays UG and UGDER"
2431 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2432 ((ug(l,k,i),l=1,2),k=1,2),&
2433 ((ugder(l,k,i),l=1,2),k=1,2)
2435 write (iout,*) "Arrays UG2 and UG2DER"
2437 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2438 ((ug2(l,k,i),l=1,2),k=1,2),&
2439 ((ug2der(l,k,i),l=1,2),k=1,2)
2441 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2443 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2444 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2445 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2447 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2449 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2450 costab(i),sintab(i),costab2(i),sintab2(i)
2452 write (iout,*) "Array MUDER"
2454 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2460 !d iti = itortyp(itype(i))
2463 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2464 !d & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2468 end subroutine set_matrices
2469 !-----------------------------------------------------------------------------
2470 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2472 ! This subroutine calculates the average interaction energy and its gradient
2473 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
2474 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2475 ! The potential depends both on the distance of peptide-group centers and on
2476 ! the orientation of the CA-CA virtual bonds.
2479 ! implicit real*8 (a-h,o-z)
2483 ! include 'DIMENSIONS'
2484 ! include 'COMMON.CONTROL'
2485 ! include 'COMMON.SETUP'
2486 ! include 'COMMON.IOUNITS'
2487 ! include 'COMMON.GEO'
2488 ! include 'COMMON.VAR'
2489 ! include 'COMMON.LOCAL'
2490 ! include 'COMMON.CHAIN'
2491 ! include 'COMMON.DERIV'
2492 ! include 'COMMON.INTERACT'
2493 ! include 'COMMON.CONTACTS'
2494 ! include 'COMMON.TORSION'
2495 ! include 'COMMON.VECTORS'
2496 ! include 'COMMON.FFIELD'
2497 ! include 'COMMON.TIME1'
2498 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
2499 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2500 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2501 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2502 real(kind=8),dimension(4) :: muij
2503 !el integer :: num_conti,j1,j2
2504 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2505 !el dz_normi,xmedi,ymedi,zmedi
2507 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2508 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
2511 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2513 real(kind=8) :: scal_el=1.0d0
2515 real(kind=8) :: scal_el=0.5d0
2518 ! 13-go grudnia roku pamietnego...
2519 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
2521 0.0d0,0.0d0,1.0d0/),shape(unmat))
2524 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2525 real(kind=8) :: fac,t_eelecij
2528 !d write(iout,*) 'In EELEC'
2530 !d write(iout,*) 'Type',i
2531 !d write(iout,*) 'B1',B1(:,i)
2532 !d write(iout,*) 'B2',B2(:,i)
2533 !d write(iout,*) 'CC',CC(:,:,i)
2534 !d write(iout,*) 'DD',DD(:,:,i)
2535 !d write(iout,*) 'EE',EE(:,:,i)
2537 !d call check_vecgrad
2552 if (icheckgrad.eq.1) then
2555 ! dc_norm(1,i)=0.0d0
2556 ! dc_norm(2,i)=0.0d0
2557 ! dc_norm(3,i)=0.0d0
2560 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2562 dc_norm(k,i)=dc(k,i)*fac
2564 ! write (iout,*) 'i',i,' fac',fac
2567 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
2568 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
2569 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2570 ! call vec_and_deriv
2576 time_mat=time_mat+MPI_Wtime()-time01
2580 !d write (iout,*) 'i=',i
2582 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2585 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2586 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2599 !d print '(a)','Enter EELEC'
2600 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2601 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
2602 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
2604 gel_loc_loc(i)=0.0d0
2609 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2611 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
2616 do i=iturn3_start,iturn3_end
2617 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
2618 .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2622 dx_normi=dc_norm(1,i)
2623 dy_normi=dc_norm(2,i)
2624 dz_normi=dc_norm(3,i)
2625 xmedi=c(1,i)+0.5d0*dxi
2626 ymedi=c(2,i)+0.5d0*dyi
2627 zmedi=c(3,i)+0.5d0*dzi
2629 call eelecij(i,i+2,ees,evdw1,eel_loc)
2630 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2631 num_cont_hb(i)=num_conti
2633 do i=iturn4_start,iturn4_end
2634 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
2635 .or. itype(i+3).eq.ntyp1 &
2636 .or. itype(i+4).eq.ntyp1) cycle
2640 dx_normi=dc_norm(1,i)
2641 dy_normi=dc_norm(2,i)
2642 dz_normi=dc_norm(3,i)
2643 xmedi=c(1,i)+0.5d0*dxi
2644 ymedi=c(2,i)+0.5d0*dyi
2645 zmedi=c(3,i)+0.5d0*dzi
2646 num_conti=num_cont_hb(i)
2647 call eelecij(i,i+3,ees,evdw1,eel_loc)
2648 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
2649 call eturn4(i,eello_turn4)
2650 num_cont_hb(i)=num_conti
2653 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2655 do i=iatel_s,iatel_e
2656 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2660 dx_normi=dc_norm(1,i)
2661 dy_normi=dc_norm(2,i)
2662 dz_normi=dc_norm(3,i)
2663 xmedi=c(1,i)+0.5d0*dxi
2664 ymedi=c(2,i)+0.5d0*dyi
2665 zmedi=c(3,i)+0.5d0*dzi
2666 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2667 num_conti=num_cont_hb(i)
2668 do j=ielstart(i),ielend(i)
2669 ! write (iout,*) i,j,itype(i),itype(j)
2670 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2671 call eelecij(i,j,ees,evdw1,eel_loc)
2673 num_cont_hb(i)=num_conti
2675 ! write (iout,*) "Number of loop steps in EELEC:",ind
2677 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
2678 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2680 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2681 !cc eel_loc=eel_loc+eello_turn3
2682 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
2684 end subroutine eelec
2685 !-----------------------------------------------------------------------------
2686 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2689 ! implicit real*8 (a-h,o-z)
2690 ! include 'DIMENSIONS'
2694 ! include 'COMMON.CONTROL'
2695 ! include 'COMMON.IOUNITS'
2696 ! include 'COMMON.GEO'
2697 ! include 'COMMON.VAR'
2698 ! include 'COMMON.LOCAL'
2699 ! include 'COMMON.CHAIN'
2700 ! include 'COMMON.DERIV'
2701 ! include 'COMMON.INTERACT'
2702 ! include 'COMMON.CONTACTS'
2703 ! include 'COMMON.TORSION'
2704 ! include 'COMMON.VECTORS'
2705 ! include 'COMMON.FFIELD'
2706 ! include 'COMMON.TIME1'
2707 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
2708 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2709 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2710 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2711 real(kind=8),dimension(4) :: muij
2712 !el integer :: num_conti,j1,j2
2713 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2714 !el dz_normi,xmedi,ymedi,zmedi
2716 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2717 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
2720 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2722 real(kind=8) :: scal_el=1.0d0
2724 real(kind=8) :: scal_el=0.5d0
2727 ! 13-go grudnia roku pamietnego...
2728 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
2730 0.0d0,0.0d0,1.0d0/),shape(unmat))
2731 ! integer :: maxconts=nres/4
2733 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m
2734 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
2735 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
2736 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
2737 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
2738 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
2739 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
2740 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
2741 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
2742 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
2743 ecosgp,ecosam,ecosbm,ecosgm,ghalf
2745 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
2746 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
2748 ! time00=MPI_Wtime()
2749 !d write (iout,*) "eelecij",i,j
2753 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2754 aaa=app(iteli,itelj)
2755 bbb=bpp(iteli,itelj)
2756 ael6i=ael6(iteli,itelj)
2757 ael3i=ael3(iteli,itelj)
2761 dx_normj=dc_norm(1,j)
2762 dy_normj=dc_norm(2,j)
2763 dz_normj=dc_norm(3,j)
2764 xj=c(1,j)+0.5D0*dxj-xmedi
2765 yj=c(2,j)+0.5D0*dyj-ymedi
2766 zj=c(3,j)+0.5D0*dzj-zmedi
2767 rij=xj*xj+yj*yj+zj*zj
2773 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2774 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2775 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2776 fac=cosa-3.0D0*cosb*cosg
2778 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2779 if (j.eq.i+2) ev1=scal_el*ev1
2784 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2787 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
2788 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2791 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2792 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2793 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2794 !d & xmedi,ymedi,zmedi,xj,yj,zj
2796 if (energy_dec) then
2797 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
2798 'evdw1',i,j,evdwij,&
2799 iteli,itelj,aaa,evdw1
2800 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2803 ! Calculate contributions to the Cartesian gradient.
2806 facvdw=-6*rrmij*(ev1+evdwij)
2807 facel=-3*rrmij*(el1+eesij)
2813 ! Radial derivatives. First process both termini of the fragment (i,j)
2819 ! ghalf=0.5D0*ggg(k)
2820 ! gelc(k,i)=gelc(k,i)+ghalf
2821 ! gelc(k,j)=gelc(k,j)+ghalf
2823 ! 9/28/08 AL Gradient compotents will be summed only at the end
2825 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2826 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2829 ! Loop over residues i+1 thru j-1.
2833 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2840 ! ghalf=0.5D0*ggg(k)
2841 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2842 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2844 ! 9/28/08 AL Gradient compotents will be summed only at the end
2846 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2847 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2850 ! Loop over residues i+1 thru j-1.
2854 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2861 fac=-3*rrmij*(facvdw+facvdw+facel)
2866 ! Radial derivatives. First process both termini of the fragment (i,j)
2872 ! ghalf=0.5D0*ggg(k)
2873 ! gelc(k,i)=gelc(k,i)+ghalf
2874 ! gelc(k,j)=gelc(k,j)+ghalf
2876 ! 9/28/08 AL Gradient compotents will be summed only at the end
2878 gelc_long(k,j)=gelc(k,j)+ggg(k)
2879 gelc_long(k,i)=gelc(k,i)-ggg(k)
2882 ! Loop over residues i+1 thru j-1.
2886 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2889 ! 9/28/08 AL Gradient compotents will be summed only at the end
2894 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2895 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2901 ecosa=2.0D0*fac3*fac1+fac4
2904 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2905 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2907 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2908 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2910 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2911 !d & (dcosg(k),k=1,3)
2913 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2916 ! ghalf=0.5D0*ggg(k)
2917 ! gelc(k,i)=gelc(k,i)+ghalf
2918 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2919 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2920 ! gelc(k,j)=gelc(k,j)+ghalf
2921 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2922 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2926 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2930 gelc(k,i)=gelc(k,i) &
2931 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
2932 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2933 gelc(k,j)=gelc(k,j) &
2934 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
2935 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2936 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2937 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2939 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
2940 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
2941 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2943 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2944 ! energy of a peptide unit is assumed in the form of a second-order
2945 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2946 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2947 ! are computed for EVERY pair of non-contiguous peptide groups.
2949 if (j.lt.nres-1) then
2960 muij(kkk)=mu(k,i)*mu(l,j)
2963 !d write (iout,*) 'EELEC: i',i,' j',j
2964 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
2965 !d write(iout,*) 'muij',muij
2966 ury=scalar(uy(1,i),erij)
2967 urz=scalar(uz(1,i),erij)
2968 vry=scalar(uy(1,j),erij)
2969 vrz=scalar(uz(1,j),erij)
2970 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2971 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2972 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2973 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2974 fac=dsqrt(-ael6i)*r3ij
2979 !d write (iout,'(4i5,4f10.5)')
2980 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2981 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2982 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2983 !d & uy(:,j),uz(:,j)
2984 !d write (iout,'(4f10.5)')
2985 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2986 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2987 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
2988 !d write (iout,'(9f10.5/)')
2989 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2990 ! Derivatives of the elements of A in virtual-bond vectors
2991 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2993 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2994 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2995 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2996 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2997 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2998 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2999 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3000 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3001 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3002 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3003 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3004 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3006 ! Compute radial contributions to the gradient
3024 ! Add the contributions coming from er
3027 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3028 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3029 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3030 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3033 ! Derivatives in DC(i)
3034 !grad ghalf1=0.5d0*agg(k,1)
3035 !grad ghalf2=0.5d0*agg(k,2)
3036 !grad ghalf3=0.5d0*agg(k,3)
3037 !grad ghalf4=0.5d0*agg(k,4)
3038 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
3039 -3.0d0*uryg(k,2)*vry)!+ghalf1
3040 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
3041 -3.0d0*uryg(k,2)*vrz)!+ghalf2
3042 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
3043 -3.0d0*urzg(k,2)*vry)!+ghalf3
3044 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
3045 -3.0d0*urzg(k,2)*vrz)!+ghalf4
3046 ! Derivatives in DC(i+1)
3047 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
3048 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3049 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
3050 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3051 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
3052 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3053 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
3054 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3055 ! Derivatives in DC(j)
3056 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
3057 -3.0d0*vryg(k,2)*ury)!+ghalf1
3058 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
3059 -3.0d0*vrzg(k,2)*ury)!+ghalf2
3060 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
3061 -3.0d0*vryg(k,2)*urz)!+ghalf3
3062 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
3063 -3.0d0*vrzg(k,2)*urz)!+ghalf4
3064 ! Derivatives in DC(j+1) or DC(nres-1)
3065 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
3066 -3.0d0*vryg(k,3)*ury)
3067 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
3068 -3.0d0*vrzg(k,3)*ury)
3069 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
3070 -3.0d0*vryg(k,3)*urz)
3071 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
3072 -3.0d0*vrzg(k,3)*urz)
3073 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
3075 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3088 aggi(k,l)=-aggi(k,l)
3089 aggi1(k,l)=-aggi1(k,l)
3090 aggj(k,l)=-aggj(k,l)
3091 aggj1(k,l)=-aggj1(k,l)
3094 if (j.lt.nres-1) then
3100 aggi(k,l)=-aggi(k,l)
3101 aggi1(k,l)=-aggi1(k,l)
3102 aggj(k,l)=-aggj(k,l)
3103 aggj1(k,l)=-aggj1(k,l)
3114 aggi(k,l)=-aggi(k,l)
3115 aggi1(k,l)=-aggi1(k,l)
3116 aggj(k,l)=-aggj(k,l)
3117 aggj1(k,l)=-aggj1(k,l)
3122 IF (wel_loc.gt.0.0d0) THEN
3123 ! Contribution to the local-electrostatic energy coming from the i-j pair
3124 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
3126 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3128 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3129 'eelloc',i,j,eel_loc_ij
3130 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
3131 ! if (energy_dec) write (iout,*) "muij",muij
3132 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3134 eel_loc=eel_loc+eel_loc_ij
3135 ! Partial derivatives in virtual-bond dihedral angles gamma
3137 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
3138 a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
3139 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3140 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
3141 a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
3142 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3143 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3145 ggg(l)=agg(l,1)*muij(1)+ &
3146 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3147 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3148 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3149 !grad ghalf=0.5d0*ggg(l)
3150 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
3151 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
3155 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3158 ! Remaining derivatives of eello
3160 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ &
3161 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3162 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ &
3163 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3164 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ &
3165 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3166 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ &
3167 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3170 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
3171 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
3172 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
3173 .and. num_conti.le.maxconts) then
3174 ! write (iout,*) i,j," entered corr"
3176 ! Calculate the contact function. The ith column of the array JCONT will
3177 ! contain the numbers of atoms that make contacts with the atom I (of numbers
3178 ! greater than I). The arrays FACONT and GACONT will contain the values of
3179 ! the contact function and its derivative.
3180 ! r0ij=1.02D0*rpp(iteli,itelj)
3181 ! r0ij=1.11D0*rpp(iteli,itelj)
3182 r0ij=2.20D0*rpp(iteli,itelj)
3183 ! r0ij=1.55D0*rpp(iteli,itelj)
3184 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3185 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
3186 if (fcont.gt.0.0D0) then
3187 num_conti=num_conti+1
3188 if (num_conti.gt.maxconts) then
3189 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
3190 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
3191 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
3192 ' will skip next contacts for this conf.', num_conti
3194 jcont_hb(num_conti,i)=j
3195 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
3196 !d & " jcont_hb",jcont_hb(num_conti,i)
3197 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
3198 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3199 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3201 d_cont(num_conti,i)=rij
3202 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3203 ! --- Electrostatic-interaction matrix ---
3204 a_chuj(1,1,num_conti,i)=a22
3205 a_chuj(1,2,num_conti,i)=a23
3206 a_chuj(2,1,num_conti,i)=a32
3207 a_chuj(2,2,num_conti,i)=a33
3208 ! --- Gradient of rij
3210 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3217 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3218 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3219 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3220 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3221 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3226 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3227 ! Calculate contact energies
3229 wij=cosa-3.0D0*cosb*cosg
3232 ! fac3=dsqrt(-ael6i)/r0ij**3
3233 fac3=dsqrt(-ael6i)*r3ij
3234 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3235 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3236 if (ees0tmp.gt.0) then
3237 ees0pij=dsqrt(ees0tmp)
3241 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3242 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3243 if (ees0tmp.gt.0) then
3244 ees0mij=dsqrt(ees0tmp)
3249 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3250 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3251 ! Diagnostics. Comment out or remove after debugging!
3252 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3253 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3254 ! ees0m(num_conti,i)=0.0D0
3256 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3257 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3258 ! Angular derivatives of the contact function
3259 ees0pij1=fac3/ees0pij
3260 ees0mij1=fac3/ees0mij
3261 fac3p=-3.0D0*fac3*rrmij
3262 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3263 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3265 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3266 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3267 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3268 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3269 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3270 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3271 ecosap=ecosa1+ecosa2
3272 ecosbp=ecosb1+ecosb2
3273 ecosgp=ecosg1+ecosg2
3274 ecosam=ecosa1-ecosa2
3275 ecosbm=ecosb1-ecosb2
3276 ecosgm=ecosg1-ecosg2
3285 facont_hb(num_conti,i)=fcont
3286 fprimcont=fprimcont/rij
3287 !d facont_hb(num_conti,i)=1.0D0
3288 ! Following line is for diagnostics.
3291 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3292 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3295 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3296 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3298 gggp(1)=gggp(1)+ees0pijp*xj
3299 gggp(2)=gggp(2)+ees0pijp*yj
3300 gggp(3)=gggp(3)+ees0pijp*zj
3301 gggm(1)=gggm(1)+ees0mijp*xj
3302 gggm(2)=gggm(2)+ees0mijp*yj
3303 gggm(3)=gggm(3)+ees0mijp*zj
3304 ! Derivatives due to the contact function
3305 gacont_hbr(1,num_conti,i)=fprimcont*xj
3306 gacont_hbr(2,num_conti,i)=fprimcont*yj
3307 gacont_hbr(3,num_conti,i)=fprimcont*zj
3310 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
3311 ! following the change of gradient-summation algorithm.
3313 !grad ghalfp=0.5D0*gggp(k)
3314 !grad ghalfm=0.5D0*gggm(k)
3315 gacontp_hb1(k,num_conti,i)= & !ghalfp+
3316 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3317 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3318 gacontp_hb2(k,num_conti,i)= & !ghalfp+
3319 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3320 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3321 gacontp_hb3(k,num_conti,i)=gggp(k)
3322 gacontm_hb1(k,num_conti,i)= & !ghalfm+
3323 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3324 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3325 gacontm_hb2(k,num_conti,i)= & !ghalfm+
3326 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3327 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3328 gacontm_hb3(k,num_conti,i)=gggm(k)
3330 ! Diagnostics. Comment out or remove after debugging!
3332 !diag gacontp_hb1(k,num_conti,i)=0.0D0
3333 !diag gacontp_hb2(k,num_conti,i)=0.0D0
3334 !diag gacontp_hb3(k,num_conti,i)=0.0D0
3335 !diag gacontm_hb1(k,num_conti,i)=0.0D0
3336 !diag gacontm_hb2(k,num_conti,i)=0.0D0
3337 !diag gacontm_hb3(k,num_conti,i)=0.0D0
3340 endif ! num_conti.le.maxconts
3343 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3346 ghalf=0.5d0*agg(l,k)
3347 aggi(l,k)=aggi(l,k)+ghalf
3348 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3349 aggj(l,k)=aggj(l,k)+ghalf
3352 if (j.eq.nres-1 .and. i.lt.j-2) then
3355 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3360 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
3362 end subroutine eelecij
3363 !-----------------------------------------------------------------------------
3364 subroutine eturn3(i,eello_turn3)
3365 ! Third- and fourth-order contributions from turns
3368 ! implicit real*8 (a-h,o-z)
3369 ! include 'DIMENSIONS'
3370 ! include 'COMMON.IOUNITS'
3371 ! include 'COMMON.GEO'
3372 ! include 'COMMON.VAR'
3373 ! include 'COMMON.LOCAL'
3374 ! include 'COMMON.CHAIN'
3375 ! include 'COMMON.DERIV'
3376 ! include 'COMMON.INTERACT'
3377 ! include 'COMMON.CONTACTS'
3378 ! include 'COMMON.TORSION'
3379 ! include 'COMMON.VECTORS'
3380 ! include 'COMMON.FFIELD'
3381 ! include 'COMMON.CONTROL'
3382 real(kind=8),dimension(3) :: ggg
3383 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
3384 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
3385 real(kind=8),dimension(2) :: auxvec,auxvec1
3386 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3387 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
3388 !el integer :: num_conti,j1,j2
3389 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3390 !el dz_normi,xmedi,ymedi,zmedi
3392 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3393 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3397 real(kind=8) :: eello_turn3
3400 ! write (iout,*) "eturn3",i,j,j1,j2
3405 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3407 ! Third-order contributions
3414 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3415 !d call checkint_turn3(i,a_temp,eello_turn3_num)
3416 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3417 call transpose2(auxmat(1,1),auxmat1(1,1))
3418 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3419 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3420 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3421 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3422 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
3423 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
3424 !d & ' eello_turn3_num',4*eello_turn3_num
3425 ! Derivatives in gamma(i)
3426 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3427 call transpose2(auxmat2(1,1),auxmat3(1,1))
3428 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3429 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3430 ! Derivatives in gamma(i+1)
3431 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3432 call transpose2(auxmat2(1,1),auxmat3(1,1))
3433 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3434 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
3435 +0.5d0*(pizda(1,1)+pizda(2,2))
3436 ! Cartesian derivatives
3438 ! ghalf1=0.5d0*agg(l,1)
3439 ! ghalf2=0.5d0*agg(l,2)
3440 ! ghalf3=0.5d0*agg(l,3)
3441 ! ghalf4=0.5d0*agg(l,4)
3442 a_temp(1,1)=aggi(l,1)!+ghalf1
3443 a_temp(1,2)=aggi(l,2)!+ghalf2
3444 a_temp(2,1)=aggi(l,3)!+ghalf3
3445 a_temp(2,2)=aggi(l,4)!+ghalf4
3446 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3447 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
3448 +0.5d0*(pizda(1,1)+pizda(2,2))
3449 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3450 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3451 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3452 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3453 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3454 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
3455 +0.5d0*(pizda(1,1)+pizda(2,2))
3456 a_temp(1,1)=aggj(l,1)!+ghalf1
3457 a_temp(1,2)=aggj(l,2)!+ghalf2
3458 a_temp(2,1)=aggj(l,3)!+ghalf3
3459 a_temp(2,2)=aggj(l,4)!+ghalf4
3460 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3461 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
3462 +0.5d0*(pizda(1,1)+pizda(2,2))
3463 a_temp(1,1)=aggj1(l,1)
3464 a_temp(1,2)=aggj1(l,2)
3465 a_temp(2,1)=aggj1(l,3)
3466 a_temp(2,2)=aggj1(l,4)
3467 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3468 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
3469 +0.5d0*(pizda(1,1)+pizda(2,2))
3472 end subroutine eturn3
3473 !-----------------------------------------------------------------------------
3474 subroutine eturn4(i,eello_turn4)
3475 ! Third- and fourth-order contributions from turns
3478 ! implicit real*8 (a-h,o-z)
3479 ! include 'DIMENSIONS'
3480 ! include 'COMMON.IOUNITS'
3481 ! include 'COMMON.GEO'
3482 ! include 'COMMON.VAR'
3483 ! include 'COMMON.LOCAL'
3484 ! include 'COMMON.CHAIN'
3485 ! include 'COMMON.DERIV'
3486 ! include 'COMMON.INTERACT'
3487 ! include 'COMMON.CONTACTS'
3488 ! include 'COMMON.TORSION'
3489 ! include 'COMMON.VECTORS'
3490 ! include 'COMMON.FFIELD'
3491 ! include 'COMMON.CONTROL'
3492 real(kind=8),dimension(3) :: ggg
3493 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
3494 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
3495 real(kind=8),dimension(2) :: auxvec,auxvec1
3496 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3497 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
3498 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3499 !el dz_normi,xmedi,ymedi,zmedi
3500 !el integer :: num_conti,j1,j2
3501 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3502 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3505 integer :: i,j,iti1,iti2,iti3,l
3506 real(kind=8) :: eello_turn4,s1,s2,s3
3509 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3511 ! Fourth-order contributions
3519 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3520 !d call checkint_turn4(i,a_temp,eello_turn4_num)
3521 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3526 iti1=itortyp(itype(i+1))
3527 iti2=itortyp(itype(i+2))
3528 iti3=itortyp(itype(i+3))
3529 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3530 call transpose2(EUg(1,1,i+1),e1t(1,1))
3531 call transpose2(Eug(1,1,i+2),e2t(1,1))
3532 call transpose2(Eug(1,1,i+3),e3t(1,1))
3533 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3534 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3535 s1=scalar2(b1(1,iti2),auxvec(1))
3536 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3537 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3538 s2=scalar2(b1(1,iti1),auxvec(1))
3539 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3540 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3541 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3542 eello_turn4=eello_turn4-(s1+s2+s3)
3543 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3544 'eturn4',i,j,-(s1+s2+s3)
3545 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3546 !d & ' eello_turn4_num',8*eello_turn4_num
3547 ! Derivatives in gamma(i)
3548 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3549 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3550 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3551 s1=scalar2(b1(1,iti2),auxvec(1))
3552 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3553 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3554 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3555 ! Derivatives in gamma(i+1)
3556 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3557 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3558 s2=scalar2(b1(1,iti1),auxvec(1))
3559 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3560 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3561 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3562 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3563 ! Derivatives in gamma(i+2)
3564 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3565 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3566 s1=scalar2(b1(1,iti2),auxvec(1))
3567 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3568 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3569 s2=scalar2(b1(1,iti1),auxvec(1))
3570 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3571 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3572 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3573 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3574 ! Cartesian derivatives
3575 ! Derivatives of this turn contributions in DC(i+2)
3576 if (j.lt.nres-1) then
3578 a_temp(1,1)=agg(l,1)
3579 a_temp(1,2)=agg(l,2)
3580 a_temp(2,1)=agg(l,3)
3581 a_temp(2,2)=agg(l,4)
3582 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3583 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3584 s1=scalar2(b1(1,iti2),auxvec(1))
3585 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3586 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3587 s2=scalar2(b1(1,iti1),auxvec(1))
3588 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3589 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3590 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3592 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3595 ! Remaining derivatives of this turn contribution
3597 a_temp(1,1)=aggi(l,1)
3598 a_temp(1,2)=aggi(l,2)
3599 a_temp(2,1)=aggi(l,3)
3600 a_temp(2,2)=aggi(l,4)
3601 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3602 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3603 s1=scalar2(b1(1,iti2),auxvec(1))
3604 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3605 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3606 s2=scalar2(b1(1,iti1),auxvec(1))
3607 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3608 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3609 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3610 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3611 a_temp(1,1)=aggi1(l,1)
3612 a_temp(1,2)=aggi1(l,2)
3613 a_temp(2,1)=aggi1(l,3)
3614 a_temp(2,2)=aggi1(l,4)
3615 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3616 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3617 s1=scalar2(b1(1,iti2),auxvec(1))
3618 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3619 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3620 s2=scalar2(b1(1,iti1),auxvec(1))
3621 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3622 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3623 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3624 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3625 a_temp(1,1)=aggj(l,1)
3626 a_temp(1,2)=aggj(l,2)
3627 a_temp(2,1)=aggj(l,3)
3628 a_temp(2,2)=aggj(l,4)
3629 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3630 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3631 s1=scalar2(b1(1,iti2),auxvec(1))
3632 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3633 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3634 s2=scalar2(b1(1,iti1),auxvec(1))
3635 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3636 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3637 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3638 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3639 a_temp(1,1)=aggj1(l,1)
3640 a_temp(1,2)=aggj1(l,2)
3641 a_temp(2,1)=aggj1(l,3)
3642 a_temp(2,2)=aggj1(l,4)
3643 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3644 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3645 s1=scalar2(b1(1,iti2),auxvec(1))
3646 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3647 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3648 s2=scalar2(b1(1,iti1),auxvec(1))
3649 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3650 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3651 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3652 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3653 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3656 end subroutine eturn4
3657 !-----------------------------------------------------------------------------
3658 subroutine unormderiv(u,ugrad,unorm,ungrad)
3659 ! This subroutine computes the derivatives of a normalized vector u, given
3660 ! the derivatives computed without normalization conditions, ugrad. Returns
3663 real(kind=8),dimension(3) :: u,vec
3664 real(kind=8),dimension(3,3) ::ugrad,ungrad
3665 real(kind=8) :: unorm !,scalar
3667 ! write (2,*) 'ugrad',ugrad
3670 vec(i)=scalar(ugrad(1,i),u(1))
3672 ! write (2,*) 'vec',vec
3675 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3678 ! write (2,*) 'ungrad',ungrad
3680 end subroutine unormderiv
3681 !-----------------------------------------------------------------------------
3682 subroutine escp_soft_sphere(evdw2,evdw2_14)
3684 ! This subroutine calculates the excluded-volume interaction energy between
3685 ! peptide-group centers and side chains and its gradient in virtual-bond and
3686 ! side-chain vectors.
3688 ! implicit real*8 (a-h,o-z)
3689 ! include 'DIMENSIONS'
3690 ! include 'COMMON.GEO'
3691 ! include 'COMMON.VAR'
3692 ! include 'COMMON.LOCAL'
3693 ! include 'COMMON.CHAIN'
3694 ! include 'COMMON.DERIV'
3695 ! include 'COMMON.INTERACT'
3696 ! include 'COMMON.FFIELD'
3697 ! include 'COMMON.IOUNITS'
3698 ! include 'COMMON.CONTROL'
3699 real(kind=8),dimension(3) :: ggg
3701 integer :: i,iint,j,k,iteli,itypj
3702 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
3703 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
3708 !d print '(a)','Enter ESCP'
3709 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3710 do i=iatscp_s,iatscp_e
3711 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3713 xi=0.5D0*(c(1,i)+c(1,i+1))
3714 yi=0.5D0*(c(2,i)+c(2,i+1))
3715 zi=0.5D0*(c(3,i)+c(3,i+1))
3717 do iint=1,nscp_gr(i)
3719 do j=iscpstart(i,iint),iscpend(i,iint)
3720 if (itype(j).eq.ntyp1) cycle
3721 itypj=iabs(itype(j))
3722 ! Uncomment following three lines for SC-p interactions
3726 ! Uncomment following three lines for Ca-p interactions
3730 rij=xj*xj+yj*yj+zj*zj
3733 if (rij.lt.r0ijsq) then
3734 evdwij=0.25d0*(rij-r0ijsq)**2
3742 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
3747 !grad if (j.lt.i) then
3748 !d write (iout,*) 'j<i'
3749 ! Uncomment following three lines for SC-p interactions
3751 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3754 !d write (iout,*) 'j>i'
3756 !grad ggg(k)=-ggg(k)
3757 ! Uncomment following line for SC-p interactions
3758 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3762 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3764 !grad kstart=min0(i+1,j)
3765 !grad kend=max0(i-1,j-1)
3766 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3767 !d write (iout,*) ggg(1),ggg(2),ggg(3)
3768 !grad do k=kstart,kend
3770 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3774 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3775 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3782 end subroutine escp_soft_sphere
3783 !-----------------------------------------------------------------------------
3784 subroutine escp(evdw2,evdw2_14)
3786 ! This subroutine calculates the excluded-volume interaction energy between
3787 ! peptide-group centers and side chains and its gradient in virtual-bond and
3788 ! side-chain vectors.
3790 ! implicit real*8 (a-h,o-z)
3791 ! include 'DIMENSIONS'
3792 ! include 'COMMON.GEO'
3793 ! include 'COMMON.VAR'
3794 ! include 'COMMON.LOCAL'
3795 ! include 'COMMON.CHAIN'
3796 ! include 'COMMON.DERIV'
3797 ! include 'COMMON.INTERACT'
3798 ! include 'COMMON.FFIELD'
3799 ! include 'COMMON.IOUNITS'
3800 ! include 'COMMON.CONTROL'
3801 real(kind=8),dimension(3) :: ggg
3803 integer :: i,iint,j,k,iteli,itypj
3804 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
3809 !d print '(a)','Enter ESCP'
3810 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3811 do i=iatscp_s,iatscp_e
3812 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3814 xi=0.5D0*(c(1,i)+c(1,i+1))
3815 yi=0.5D0*(c(2,i)+c(2,i+1))
3816 zi=0.5D0*(c(3,i)+c(3,i+1))
3818 do iint=1,nscp_gr(i)
3820 do j=iscpstart(i,iint),iscpend(i,iint)
3821 itypj=iabs(itype(j))
3822 if (itypj.eq.ntyp1) cycle
3823 ! Uncomment following three lines for SC-p interactions
3827 ! Uncomment following three lines for Ca-p interactions
3831 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3833 e1=fac*fac*aad(itypj,iteli)
3834 e2=fac*bad(itypj,iteli)
3835 if (iabs(j-i) .le. 2) then
3838 evdw2_14=evdw2_14+e1+e2
3842 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
3843 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
3846 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
3848 fac=-(evdwij+e1)*rrij
3852 !grad if (j.lt.i) then
3853 !d write (iout,*) 'j<i'
3854 ! Uncomment following three lines for SC-p interactions
3856 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3859 !d write (iout,*) 'j>i'
3861 !grad ggg(k)=-ggg(k)
3862 ! Uncomment following line for SC-p interactions
3863 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3864 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3868 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3870 !grad kstart=min0(i+1,j)
3871 !grad kend=max0(i-1,j-1)
3872 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3873 !d write (iout,*) ggg(1),ggg(2),ggg(3)
3874 !grad do k=kstart,kend
3876 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3880 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3881 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3889 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3890 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
3891 gradx_scp(j,i)=expon*gradx_scp(j,i)
3894 !******************************************************************************
3898 ! To save time the factor EXPON has been extracted from ALL components
3899 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
3902 !******************************************************************************
3905 !-----------------------------------------------------------------------------
3906 subroutine edis(ehpb)
3908 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3910 ! implicit real*8 (a-h,o-z)
3911 ! include 'DIMENSIONS'
3912 ! include 'COMMON.SBRIDGE'
3913 ! include 'COMMON.CHAIN'
3914 ! include 'COMMON.DERIV'
3915 ! include 'COMMON.VAR'
3916 ! include 'COMMON.INTERACT'
3917 ! include 'COMMON.IOUNITS'
3918 real(kind=8),dimension(3) :: ggg
3920 integer :: i,j,ii,jj,iii,jjj,k
3921 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
3924 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
3925 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
3926 if (link_end.eq.0) return
3927 do i=link_start,link_end
3928 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3929 ! CA-CA distance used in regularization of structure.
3932 ! iii and jjj point to the residues for which the distance is assigned.
3933 if (ii.gt.nres) then
3940 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
3941 ! & dhpb(i),dhpb1(i),forcon(i)
3942 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
3943 ! distance and angle dependent SS bond potential.
3944 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
3945 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
3946 if (.not.dyn_ss .and. i.le.nss) then
3947 ! 15/02/13 CC dynamic SSbond - additional check
3948 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. &
3949 iabs(itype(jjj)).eq.1) then
3950 call ssbond_ene(iii,jjj,eij)
3952 !d write (iout,*) "eij",eij
3955 ! Calculate the distance between the two points and its difference from the
3959 ! Get the force constant corresponding to this distance.
3961 ! Calculate the contribution to energy.
3962 ehpb=ehpb+waga*rdis*rdis
3964 ! Evaluate gradient.
3967 !d print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3968 !d & ' waga=',waga,' fac=',fac
3970 ggg(j)=fac*(c(j,jj)-c(j,ii))
3972 !d print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3973 ! If this is a SC-SC distance, we need to calculate the contributions to the
3974 ! Cartesian gradient in the SC vectors (ghpbx).
3977 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3978 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3981 !grad do j=iii,jjj-1
3983 !grad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3987 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3988 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3995 !-----------------------------------------------------------------------------
3996 subroutine ssbond_ene(i,j,eij)
3998 ! Calculate the distance and angle dependent SS-bond potential energy
3999 ! using a free-energy function derived based on RHF/6-31G** ab initio
4000 ! calculations of diethyl disulfide.
4002 ! A. Liwo and U. Kozlowska, 11/24/03
4004 ! implicit real*8 (a-h,o-z)
4005 ! include 'DIMENSIONS'
4006 ! include 'COMMON.SBRIDGE'
4007 ! include 'COMMON.CHAIN'
4008 ! include 'COMMON.DERIV'
4009 ! include 'COMMON.LOCAL'
4010 ! include 'COMMON.INTERACT'
4011 ! include 'COMMON.VAR'
4012 ! include 'COMMON.IOUNITS'
4013 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
4015 integer :: i,j,itypi,itypj,k
4016 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
4017 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
4018 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
4021 itypi=iabs(itype(i))
4025 dxi=dc_norm(1,nres+i)
4026 dyi=dc_norm(2,nres+i)
4027 dzi=dc_norm(3,nres+i)
4028 ! dsci_inv=dsc_inv(itypi)
4029 dsci_inv=vbld_inv(nres+i)
4030 itypj=iabs(itype(j))
4031 ! dscj_inv=dsc_inv(itypj)
4032 dscj_inv=vbld_inv(nres+j)
4036 dxj=dc_norm(1,nres+j)
4037 dyj=dc_norm(2,nres+j)
4038 dzj=dc_norm(3,nres+j)
4039 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4044 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4045 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4046 om12=dxi*dxj+dyi*dyj+dzi*dzj
4048 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4049 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4055 deltat12=om2-om1+2.0d0
4057 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
4058 +akct*deltad*deltat12 &
4059 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4060 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4061 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4062 ! & " deltat12",deltat12," eij",eij
4063 ed=2*akcm*deltad+akct*deltat12
4065 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4066 eom1=-2*akth*deltat1-pom1-om2*pom2
4067 eom2= 2*akth*deltat2+pom1-om1*pom2
4070 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4071 ghpbx(k,i)=ghpbx(k,i)-ggk &
4072 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
4073 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4074 ghpbx(k,j)=ghpbx(k,j)+ggk &
4075 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
4076 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4077 ghpbc(k,i)=ghpbc(k,i)-ggk
4078 ghpbc(k,j)=ghpbc(k,j)+ggk
4081 ! Calculate the components of the gradient in DC and X
4085 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4089 end subroutine ssbond_ene
4090 !-----------------------------------------------------------------------------
4091 subroutine ebond(estr)
4093 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4095 ! implicit real*8 (a-h,o-z)
4096 ! include 'DIMENSIONS'
4097 ! include 'COMMON.LOCAL'
4098 ! include 'COMMON.GEO'
4099 ! include 'COMMON.INTERACT'
4100 ! include 'COMMON.DERIV'
4101 ! include 'COMMON.VAR'
4102 ! include 'COMMON.CHAIN'
4103 ! include 'COMMON.IOUNITS'
4104 ! include 'COMMON.NAMES'
4105 ! include 'COMMON.FFIELD'
4106 ! include 'COMMON.CONTROL'
4107 ! include 'COMMON.SETUP'
4108 real(kind=8),dimension(3) :: u,ud
4110 integer :: i,j,iti,nbi,k
4111 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
4116 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
4117 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
4119 do i=ibondp_start,ibondp_end
4120 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4121 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4123 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
4126 if (energy_dec) write(iout,*) &
4127 "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4129 diff = vbld(i)-vbldp0
4130 if (energy_dec) write (iout,*) &
4131 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4134 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4136 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4139 estr=0.5d0*AKP*estr+estr1
4141 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4143 do i=ibond_start,ibond_end
4145 if (iti.ne.10 .and. iti.ne.ntyp1) then
4148 diff=vbld(i+nres)-vbldsc0(1,iti)
4149 if (energy_dec) write (iout,*) &
4150 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
4151 AKSC(1,iti),AKSC(1,iti)*diff*diff
4152 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4154 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4158 diff=vbld(i+nres)-vbldsc0(j,iti)
4159 ud(j)=aksc(j,iti)*diff
4160 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4174 uprod2=uprod2*u(k)*u(k)
4178 usumsqder=usumsqder+ud(j)*uprod2
4180 estr=estr+uprod/usum
4182 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4188 end subroutine ebond
4190 !-----------------------------------------------------------------------------
4191 subroutine ebend(etheta)
4193 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4194 ! angles gamma and its derivatives in consecutive thetas and gammas.
4197 ! implicit real*8 (a-h,o-z)
4198 ! include 'DIMENSIONS'
4199 ! include 'COMMON.LOCAL'
4200 ! include 'COMMON.GEO'
4201 ! include 'COMMON.INTERACT'
4202 ! include 'COMMON.DERIV'
4203 ! include 'COMMON.VAR'
4204 ! include 'COMMON.CHAIN'
4205 ! include 'COMMON.IOUNITS'
4206 ! include 'COMMON.NAMES'
4207 ! include 'COMMON.FFIELD'
4208 ! include 'COMMON.CONTROL'
4209 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
4210 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4211 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
4213 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
4214 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4215 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4217 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
4219 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
4220 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
4221 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
4222 real(kind=8),dimension(2) :: y,z
4225 ! time11=dexp(-2*time)
4228 ! write (*,'(a,i2)') 'EBEND ICG=',icg
4229 do i=ithet_start,ithet_end
4230 if (itype(i-1).eq.ntyp1) cycle
4231 ! Zero the energy function and its derivative at 0 or pi.
4232 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4234 ichir1=isign(1,itype(i-2))
4235 ichir2=isign(1,itype(i))
4236 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4237 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4238 if (itype(i-1).eq.10) then
4239 itype1=isign(10,itype(i-2))
4240 ichir11=isign(1,itype(i-2))
4241 ichir12=isign(1,itype(i-2))
4242 itype2=isign(10,itype(i))
4243 ichir21=isign(1,itype(i))
4244 ichir22=isign(1,itype(i))
4247 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4250 if (phii.ne.phii) phii=150.0
4260 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4263 if (phii1.ne.phii1) phii1=150.0
4275 ! Calculate the "mean" value of theta from the part of the distribution
4276 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4277 ! In following comments this theta will be referred to as t_c.
4278 thet_pred_mean=0.0d0
4280 athetk=athet(k,it,ichir1,ichir2)
4281 bthetk=bthet(k,it,ichir1,ichir2)
4283 athetk=athet(k,itype1,ichir11,ichir12)
4284 bthetk=bthet(k,itype2,ichir21,ichir22)
4286 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4288 dthett=thet_pred_mean*ssd
4289 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4290 ! Derivatives of the "mean" values in gamma1 and gamma2.
4291 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
4292 +athet(2,it,ichir1,ichir2)*y(1))*ss
4293 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
4294 +bthet(2,it,ichir1,ichir2)*z(1))*ss
4296 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
4297 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
4298 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
4299 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4301 if (theta(i).gt.pi-delta) then
4302 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
4304 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4305 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4306 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
4308 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
4310 else if (theta(i).lt.delta) then
4311 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4312 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4313 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
4315 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4316 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
4319 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
4322 etheta=etheta+ethetai
4323 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
4325 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4326 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4327 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4329 ! Ufff.... We've done all this!!!
4331 end subroutine ebend
4332 !-----------------------------------------------------------------------------
4333 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
4336 ! implicit real*8 (a-h,o-z)
4337 ! include 'DIMENSIONS'
4338 ! include 'COMMON.LOCAL'
4339 ! include 'COMMON.IOUNITS'
4340 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
4341 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4342 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
4344 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
4346 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
4347 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4348 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4350 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
4351 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
4353 ! Calculate the contributions to both Gaussian lobes.
4354 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4355 ! The "polynomial part" of the "standard deviation" of this part of
4359 sig=sig*thet_pred_mean+polthet(j,it)
4361 ! Derivative of the "interior part" of the "standard deviation of the"
4362 ! gamma-dependent Gaussian lobe in t_c.
4363 sigtc=3*polthet(3,it)
4365 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4368 ! Set the parameters of both Gaussian lobes of the distribution.
4369 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4370 fac=sig*sig+sigc0(it)
4373 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4374 sigsqtc=-4.0D0*sigcsq*sigtc
4375 ! print *,i,sig,sigtc,sigsqtc
4376 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
4377 sigtc=-sigtc/(fac*fac)
4378 ! Following variable is sigma(t_c)**(-2)
4379 sigcsq=sigcsq*sigcsq
4381 sig0inv=1.0D0/sig0i**2
4382 delthec=thetai-thet_pred_mean
4383 delthe0=thetai-theta0i
4384 term1=-0.5D0*sigcsq*delthec*delthec
4385 term2=-0.5D0*sig0inv*delthe0*delthe0
4386 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4387 ! NaNs in taking the logarithm. We extract the largest exponent which is added
4388 ! to the energy (this being the log of the distribution) at the end of energy
4389 ! term evaluation for this virtual-bond angle.
4390 if (term1.gt.term2) then
4392 term2=dexp(term2-termm)
4396 term1=dexp(term1-termm)
4399 ! The ratio between the gamma-independent and gamma-dependent lobes of
4400 ! the distribution is a Gaussian function of thet_pred_mean too.
4401 diffak=gthet(2,it)-thet_pred_mean
4402 ratak=diffak/gthet(3,it)**2
4403 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4404 ! Let's differentiate it in thet_pred_mean NOW.
4406 ! Now put together the distribution terms to make complete distribution.
4407 termexp=term1+ak*term2
4408 termpre=sigc+ak*sig0i
4409 ! Contribution of the bending energy from this theta is just the -log of
4410 ! the sum of the contributions from the two lobes and the pre-exponential
4411 ! factor. Simple enough, isn't it?
4412 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4413 ! NOW the derivatives!!!
4414 ! 6/6/97 Take into account the deformation.
4415 E_theta=(delthec*sigcsq*term1 &
4416 +ak*delthe0*sig0inv*term2)/termexp
4417 E_tc=((sigtc+aktc*sig0i)/termpre &
4418 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
4419 aktc*term2)/termexp)
4421 end subroutine theteng
4423 !-----------------------------------------------------------------------------
4424 subroutine ebend(etheta)
4426 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4427 ! angles gamma and its derivatives in consecutive thetas and gammas.
4428 ! ab initio-derived potentials from
4429 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4431 ! implicit real*8 (a-h,o-z)
4432 ! include 'DIMENSIONS'
4433 ! include 'COMMON.LOCAL'
4434 ! include 'COMMON.GEO'
4435 ! include 'COMMON.INTERACT'
4436 ! include 'COMMON.DERIV'
4437 ! include 'COMMON.VAR'
4438 ! include 'COMMON.CHAIN'
4439 ! include 'COMMON.IOUNITS'
4440 ! include 'COMMON.NAMES'
4441 ! include 'COMMON.FFIELD'
4442 ! include 'COMMON.CONTROL'
4443 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
4444 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
4445 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
4446 logical :: lprn=.false., lprn1=.false.
4448 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
4449 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
4450 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl
4453 do i=ithet_start,ithet_end
4454 if (itype(i-1).eq.ntyp1) cycle
4455 if (iabs(itype(i+1)).eq.20) iblock=2
4456 if (iabs(itype(i+1)).ne.20) iblock=1
4460 theti2=0.5d0*theta(i)
4461 ityp2=ithetyp((itype(i-1)))
4463 coskt(k)=dcos(k*theti2)
4464 sinkt(k)=dsin(k*theti2)
4466 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4469 if (phii.ne.phii) phii=150.0
4473 ityp1=ithetyp((itype(i-2)))
4474 ! propagation of chirality for glycine type
4476 cosph1(k)=dcos(k*phii)
4477 sinph1(k)=dsin(k*phii)
4487 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4490 if (phii1.ne.phii1) phii1=150.0
4495 ityp3=ithetyp((itype(i)))
4497 cosph2(k)=dcos(k*phii1)
4498 sinph2(k)=dsin(k*phii1)
4508 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4511 ccl=cosph1(l)*cosph2(k-l)
4512 ssl=sinph1(l)*sinph2(k-l)
4513 scl=sinph1(l)*cosph2(k-l)
4514 csl=cosph1(l)*sinph2(k-l)
4515 cosph1ph2(l,k)=ccl-ssl
4516 cosph1ph2(k,l)=ccl+ssl
4517 sinph1ph2(l,k)=scl+csl
4518 sinph1ph2(k,l)=scl-csl
4522 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
4523 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4524 write (iout,*) "coskt and sinkt"
4526 write (iout,*) k,coskt(k),sinkt(k)
4530 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4531 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
4534 write (iout,*) "k",k,&
4535 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
4539 write (iout,*) "cosph and sinph"
4541 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4543 write (iout,*) "cosph1ph2 and sinph2ph2"
4546 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
4547 sinph1ph2(l,k),sinph1ph2(k,l)
4550 write(iout,*) "ethetai",ethetai
4554 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
4555 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
4556 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
4557 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4558 ethetai=ethetai+sinkt(m)*aux
4559 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4560 dephii=dephii+k*sinkt(m)* &
4561 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
4562 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4563 dephii1=dephii1+k*sinkt(m)* &
4564 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
4565 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4567 write (iout,*) "m",m," k",k," bbthet", &
4568 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
4569 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
4570 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
4571 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4575 write(iout,*) "ethetai",ethetai
4579 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
4580 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
4581 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
4582 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4583 ethetai=ethetai+sinkt(m)*aux
4584 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4585 dephii=dephii+l*sinkt(m)* &
4586 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
4587 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
4588 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
4589 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4590 dephii1=dephii1+(k-l)*sinkt(m)* &
4591 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
4592 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
4593 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
4594 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4596 write (iout,*) "m",m," k",k," l",l," ffthet",&
4597 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
4598 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
4599 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
4600 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
4602 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
4603 cosph1ph2(k,l)*sinkt(m),&
4604 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4612 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
4613 i,theta(i)*rad2deg,phii*rad2deg,&
4614 phii1*rad2deg,ethetai
4616 etheta=etheta+ethetai
4617 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4618 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4619 gloc(nphi+i-2,icg)=wang*dethetai
4622 end subroutine ebend
4625 !-----------------------------------------------------------------------------
4626 subroutine esc(escloc)
4627 ! Calculate the local energy of a side chain and its derivatives in the
4628 ! corresponding virtual-bond valence angles THETA and the spherical angles
4632 ! implicit real*8 (a-h,o-z)
4633 ! include 'DIMENSIONS'
4634 ! include 'COMMON.GEO'
4635 ! include 'COMMON.LOCAL'
4636 ! include 'COMMON.VAR'
4637 ! include 'COMMON.INTERACT'
4638 ! include 'COMMON.DERIV'
4639 ! include 'COMMON.CHAIN'
4640 ! include 'COMMON.IOUNITS'
4641 ! include 'COMMON.NAMES'
4642 ! include 'COMMON.FFIELD'
4643 ! include 'COMMON.CONTROL'
4644 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
4645 ddersc0,ddummy,xtemp,temp
4646 !el real(kind=8) :: time11,time12,time112,theti
4647 real(kind=8) :: escloc,delta
4648 !el integer :: it,nlobit
4649 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4652 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
4653 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
4656 ! write (iout,'(a)') 'ESC'
4657 do i=loc_start,loc_end
4659 if (it.eq.ntyp1) cycle
4660 if (it.eq.10) goto 1
4661 nlobit=nlob(iabs(it))
4662 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
4663 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4664 theti=theta(i+1)-pipol
4669 if (x(2).gt.pi-delta) then
4673 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4675 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4676 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
4678 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
4679 ddersc0(1),dersc(1))
4680 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
4681 ddersc0(3),dersc(3))
4683 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4685 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4686 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
4687 dersc0(2),esclocbi,dersc02)
4688 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
4690 call splinthet(x(2),0.5d0*delta,ss,ssd)
4695 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4697 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4698 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4700 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4702 ! write (iout,*) escloci
4703 else if (x(2).lt.delta) then
4707 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4709 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4710 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
4712 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
4713 ddersc0(1),dersc(1))
4714 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
4715 ddersc0(3),dersc(3))
4717 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4719 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4720 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
4721 dersc0(2),esclocbi,dersc02)
4722 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
4727 call splinthet(x(2),0.5d0*delta,ss,ssd)
4729 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4731 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4732 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4734 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4735 ! write (iout,*) escloci
4737 call enesc(x,escloci,dersc,ddummy,.false.)
4740 escloc=escloc+escloci
4741 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
4743 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4745 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
4747 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4748 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4753 !-----------------------------------------------------------------------------
4754 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4757 ! implicit real*8 (a-h,o-z)
4758 ! include 'DIMENSIONS'
4759 ! include 'COMMON.GEO'
4760 ! include 'COMMON.LOCAL'
4761 ! include 'COMMON.IOUNITS'
4762 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4763 real(kind=8),dimension(3) :: x,z,dersc,ddersc
4764 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
4765 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
4766 real(kind=8) :: escloci
4769 integer :: j,iii,l,k !el,it,nlobit
4770 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
4771 !el time11,time12,time112
4772 ! write (iout,*) 'it=',it,' nlobit=',nlobit
4776 if (mixed) ddersc(j)=0.0d0
4780 ! Because of periodicity of the dependence of the SC energy in omega we have
4781 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4782 ! To avoid underflows, first compute & store the exponents.
4790 z(k)=x(k)-censc(k,j,it)
4795 Axk=Axk+gaussc(l,k,j,it)*z(l)
4801 expfac=expfac+Ax(k,j,iii)*z(k)
4809 ! As in the case of ebend, we want to avoid underflows in exponentiation and
4810 ! subsequent NaNs and INFs in energy calculation.
4811 ! Find the largest exponent
4815 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4819 !d print *,'it=',it,' emin=',emin
4821 ! Compute the contribution to SC energy and derivatives
4826 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
4827 if(adexp.ne.adexp) adexp=1.0
4830 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4832 !d print *,'j=',j,' expfac=',expfac
4833 escloc_i=escloc_i+expfac
4835 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4839 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
4840 +gaussc(k,2,j,it))*expfac
4847 dersc(1)=dersc(1)/cos(theti)**2
4848 ddersc(1)=ddersc(1)/cos(theti)**2
4851 escloci=-(dlog(escloc_i)-emin)
4853 dersc(j)=dersc(j)/escloc_i
4857 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4861 end subroutine enesc
4862 !-----------------------------------------------------------------------------
4863 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4866 ! implicit real*8 (a-h,o-z)
4867 ! include 'DIMENSIONS'
4868 ! include 'COMMON.GEO'
4869 ! include 'COMMON.LOCAL'
4870 ! include 'COMMON.IOUNITS'
4871 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4872 real(kind=8),dimension(3) :: x,z,dersc
4873 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
4874 real(kind=8),dimension(nlobit) :: contr !(maxlob)
4875 real(kind=8) :: escloci,dersc12,emin
4878 integer :: j,k,l !el,it,nlobit
4879 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
4889 z(k)=x(k)-censc(k,j,it)
4895 Axk=Axk+gaussc(l,k,j,it)*z(l)
4901 expfac=expfac+Ax(k,j)*z(k)
4906 ! As in the case of ebend, we want to avoid underflows in exponentiation and
4907 ! subsequent NaNs and INFs in energy calculation.
4908 ! Find the largest exponent
4911 if (emin.gt.contr(j)) emin=contr(j)
4915 ! Compute the contribution to SC energy and derivatives
4919 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4920 escloc_i=escloc_i+expfac
4922 dersc(k)=dersc(k)+Ax(k,j)*expfac
4924 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
4925 +gaussc(1,2,j,it))*expfac
4929 dersc(1)=dersc(1)/cos(theti)**2
4930 dersc12=dersc12/cos(theti)**2
4931 escloci=-(dlog(escloc_i)-emin)
4933 dersc(j)=dersc(j)/escloc_i
4935 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4937 end subroutine enesc_bound
4939 !-----------------------------------------------------------------------------
4940 subroutine esc(escloc)
4941 ! Calculate the local energy of a side chain and its derivatives in the
4942 ! corresponding virtual-bond valence angles THETA and the spherical angles
4943 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
4944 ! added by Urszula Kozlowska. 07/11/2007
4947 ! implicit real*8 (a-h,o-z)
4948 ! include 'DIMENSIONS'
4949 ! include 'COMMON.GEO'
4950 ! include 'COMMON.LOCAL'
4951 ! include 'COMMON.VAR'
4952 ! include 'COMMON.SCROT'
4953 ! include 'COMMON.INTERACT'
4954 ! include 'COMMON.DERIV'
4955 ! include 'COMMON.CHAIN'
4956 ! include 'COMMON.IOUNITS'
4957 ! include 'COMMON.NAMES'
4958 ! include 'COMMON.FFIELD'
4959 ! include 'COMMON.CONTROL'
4960 ! include 'COMMON.VECTORS'
4961 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
4962 real(kind=8),dimension(65) :: x
4963 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
4964 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
4965 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
4966 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
4967 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
4969 integer :: i,j,k !el,it,nlobit
4970 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
4971 !el real(kind=8) :: time11,time12,time112,theti
4972 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4973 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
4974 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
4975 sumene1x,sumene2x,sumene3x,sumene4x,&
4976 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
4979 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
4980 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
4983 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
4987 do i=loc_start,loc_end
4988 if (itype(i).eq.ntyp1) cycle
4989 costtab(i+1) =dcos(theta(i+1))
4990 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4991 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4992 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4993 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4994 cosfac=dsqrt(cosfac2)
4995 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4996 sinfac=dsqrt(sinfac2)
4998 if (it.eq.10) goto 1
5000 ! Compute the axes of tghe local cartesian coordinates system; store in
5001 ! x_prime, y_prime and z_prime
5008 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5009 ! & dc_norm(3,i+nres)
5011 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5012 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5015 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5018 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
5019 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
5020 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
5021 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5022 ! & " xy",scalar(x_prime(1),y_prime(1)),
5023 ! & " xz",scalar(x_prime(1),z_prime(1)),
5024 ! & " yy",scalar(y_prime(1),y_prime(1)),
5025 ! & " yz",scalar(y_prime(1),z_prime(1)),
5026 ! & " zz",scalar(z_prime(1),z_prime(1))
5028 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5029 ! to local coordinate system. Store in xx, yy, zz.
5035 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5036 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5037 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5044 ! Compute the energy of the ith side cbain
5046 ! write (2,*) "xx",xx," yy",yy," zz",zz
5049 x(j) = sc_parmin(j,it)
5052 !c diagnostics - remove later
5054 yy1 = dsin(alph(2))*dcos(omeg(2))
5055 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5056 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
5057 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
5059 !," --- ", xx_w,yy_w,zz_w
5062 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
5063 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
5065 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
5066 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
5068 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
5069 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
5070 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
5071 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
5072 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
5074 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
5075 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
5076 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
5077 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
5078 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
5080 dsc_i = 0.743d0+x(61)
5082 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5083 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5084 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5085 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5086 s1=(1+x(63))/(0.1d0 + dscp1)
5087 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5088 s2=(1+x(65))/(0.1d0 + dscp2)
5089 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5090 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
5091 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5092 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5094 ! & dscp1,dscp2,sumene
5095 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5096 escloc = escloc + sumene
5097 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5102 ! This section to check the numerical derivatives of the energy of ith side
5103 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5104 ! #define DEBUG in the code to turn it on.
5106 write (2,*) "sumene =",sumene
5110 write (2,*) xx,yy,zz
5111 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5112 de_dxx_num=(sumenep-sumene)/aincr
5114 write (2,*) "xx+ sumene from enesc=",sumenep
5117 write (2,*) xx,yy,zz
5118 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5119 de_dyy_num=(sumenep-sumene)/aincr
5121 write (2,*) "yy+ sumene from enesc=",sumenep
5124 write (2,*) xx,yy,zz
5125 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5126 de_dzz_num=(sumenep-sumene)/aincr
5128 write (2,*) "zz+ sumene from enesc=",sumenep
5129 costsave=cost2tab(i+1)
5130 sintsave=sint2tab(i+1)
5131 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5132 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5133 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5134 de_dt_num=(sumenep-sumene)/aincr
5135 write (2,*) " t+ sumene from enesc=",sumenep
5136 cost2tab(i+1)=costsave
5137 sint2tab(i+1)=sintsave
5138 ! End of diagnostics section.
5141 ! Compute the gradient of esc
5143 ! zz=zz*dsign(1.0,dfloat(itype(i)))
5144 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5145 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5146 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5147 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5148 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5149 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5150 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5151 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5152 pom1=(sumene3*sint2tab(i+1)+sumene1) &
5153 *(pom_s1/dscp1+pom_s16*dscp1**4)
5154 pom2=(sumene4*cost2tab(i+1)+sumene2) &
5155 *(pom_s2/dscp2+pom_s26*dscp2**4)
5156 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5157 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
5158 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
5160 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5161 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
5162 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
5164 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
5165 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
5168 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5171 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5172 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
5173 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
5175 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5176 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
5177 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
5178 +x(59)*zz**2 +x(60)*xx*zz
5179 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
5180 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
5183 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5186 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
5187 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
5188 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
5189 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
5190 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
5191 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
5192 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
5193 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5195 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5198 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
5199 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
5200 +pom1*pom_dt1+pom2*pom_dt2
5202 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5206 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5207 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5208 cosfac2xx=cosfac2*xx
5209 sinfac2yy=sinfac2*yy
5211 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
5213 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
5215 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5216 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5217 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5218 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5219 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5220 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5221 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5222 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5223 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5224 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5228 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
5229 *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5230 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
5231 *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5234 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5235 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5236 dZZ_XYZ(k)=vbld_inv(i+nres)* &
5237 (z_prime(k)-zz*dC_norm(k,i+nres))
5239 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5240 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5244 dXX_Ctab(k,i)=dXX_Ci(k)
5245 dXX_C1tab(k,i)=dXX_Ci1(k)
5246 dYY_Ctab(k,i)=dYY_Ci(k)
5247 dYY_C1tab(k,i)=dYY_Ci1(k)
5248 dZZ_Ctab(k,i)=dZZ_Ci(k)
5249 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5250 dXX_XYZtab(k,i)=dXX_XYZ(k)
5251 dYY_XYZtab(k,i)=dYY_XYZ(k)
5252 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5256 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5257 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5258 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5259 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
5260 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5262 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5263 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5264 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
5265 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5266 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
5267 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5268 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
5269 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5271 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5272 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5274 ! to check gradient call subroutine check_grad
5280 !-----------------------------------------------------------------------------
5281 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
5283 real(kind=8),dimension(65) :: x
5284 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
5285 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5287 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
5288 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
5290 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
5291 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
5293 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
5294 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
5295 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
5296 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
5297 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
5299 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
5300 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
5301 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
5302 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
5303 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
5305 dsc_i = 0.743d0+x(61)
5307 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5308 *(xx*cost2+yy*sint2))
5309 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5310 *(xx*cost2-yy*sint2))
5311 s1=(1+x(63))/(0.1d0 + dscp1)
5312 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5313 s2=(1+x(65))/(0.1d0 + dscp2)
5314 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5315 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
5316 + (sumene4*cost2 +sumene2)*(s2+s2_6)
5321 !-----------------------------------------------------------------------------
5322 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5324 ! This procedure calculates two-body contact function g(rij) and its derivative:
5327 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5330 ! where x=(rij-r0ij)/delta
5332 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5335 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
5336 real(kind=8) :: x,x2,x4,delta
5340 if (x.lt.-1.0D0) then
5343 else if (x.le.1.0D0) then
5346 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5347 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5353 end subroutine gcont
5354 !-----------------------------------------------------------------------------
5355 subroutine splinthet(theti,delta,ss,ssder)
5356 ! implicit real*8 (a-h,o-z)
5357 ! include 'DIMENSIONS'
5358 ! include 'COMMON.VAR'
5359 ! include 'COMMON.GEO'
5360 real(kind=8) :: theti,delta,ss,ssder
5361 real(kind=8) :: thetup,thetlow
5364 if (theti.gt.pipol) then
5365 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5367 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5371 end subroutine splinthet
5372 !-----------------------------------------------------------------------------
5373 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5375 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
5376 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
5377 a1=fprim0*delta/(f1-f0)
5383 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5384 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5386 end subroutine spline1
5387 !-----------------------------------------------------------------------------
5388 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5390 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
5391 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
5396 a2=3*(f1x-f0x)-2*fprim0x*delta
5397 a3=fprim0x*delta-2*(f1x-f0x)
5398 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5400 end subroutine spline2
5401 !-----------------------------------------------------------------------------
5403 !-----------------------------------------------------------------------------
5404 subroutine etor(etors,edihcnstr)
5405 ! implicit real*8 (a-h,o-z)
5406 ! include 'DIMENSIONS'
5407 ! include 'COMMON.VAR'
5408 ! include 'COMMON.GEO'
5409 ! include 'COMMON.LOCAL'
5410 ! include 'COMMON.TORSION'
5411 ! include 'COMMON.INTERACT'
5412 ! include 'COMMON.DERIV'
5413 ! include 'COMMON.CHAIN'
5414 ! include 'COMMON.NAMES'
5415 ! include 'COMMON.IOUNITS'
5416 ! include 'COMMON.FFIELD'
5417 ! include 'COMMON.TORCNSTR'
5418 ! include 'COMMON.CONTROL'
5419 real(kind=8) :: etors,edihcnstr
5423 real(kind=8) :: phii,fac,etors_ii
5425 ! Set lprn=.true. for debugging
5429 do i=iphi_start,iphi_end
5431 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 &
5432 .or. itype(i).eq.ntyp1) cycle
5433 itori=itortyp(itype(i-2))
5434 itori1=itortyp(itype(i-1))
5437 ! Proline-Proline pair is a special case...
5438 if (itori.eq.3 .and. itori1.eq.3) then
5439 if (phii.gt.-dwapi3) then
5441 fac=1.0D0/(1.0D0-cosphi)
5442 etorsi=v1(1,3,3)*fac
5443 etorsi=etorsi+etorsi
5444 etors=etors+etorsi-v1(1,3,3)
5445 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5446 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5449 v1ij=v1(j+1,itori,itori1)
5450 v2ij=v2(j+1,itori,itori1)
5453 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5454 if (energy_dec) etors_ii=etors_ii+ &
5455 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5456 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5460 v1ij=v1(j,itori,itori1)
5461 v2ij=v2(j,itori,itori1)
5464 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5465 if (energy_dec) etors_ii=etors_ii+ &
5466 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5467 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5470 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5473 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5474 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
5475 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5476 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5477 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5479 ! 6/20/98 - dihedral angle constraints
5482 itori=idih_constr(i)
5485 if (difi.gt.drange(i)) then
5487 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5488 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5489 else if (difi.lt.-drange(i)) then
5491 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5492 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5494 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5495 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5497 ! write (iout,*) 'edihcnstr',edihcnstr
5500 !-----------------------------------------------------------------------------
5501 subroutine etor_d(etors_d)
5502 real(kind=8) :: etors_d
5505 end subroutine etor_d
5507 !-----------------------------------------------------------------------------
5508 subroutine etor(etors,edihcnstr)
5509 ! implicit real*8 (a-h,o-z)
5510 ! include 'DIMENSIONS'
5511 ! include 'COMMON.VAR'
5512 ! include 'COMMON.GEO'
5513 ! include 'COMMON.LOCAL'
5514 ! include 'COMMON.TORSION'
5515 ! include 'COMMON.INTERACT'
5516 ! include 'COMMON.DERIV'
5517 ! include 'COMMON.CHAIN'
5518 ! include 'COMMON.NAMES'
5519 ! include 'COMMON.IOUNITS'
5520 ! include 'COMMON.FFIELD'
5521 ! include 'COMMON.TORCNSTR'
5522 ! include 'COMMON.CONTROL'
5523 real(kind=8) :: etors,edihcnstr
5526 integer :: i,j,iblock,itori,itori1
5527 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
5528 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
5529 ! Set lprn=.true. for debugging
5533 do i=iphi_start,iphi_end
5534 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
5535 .or. itype(i).eq.ntyp1) cycle
5537 if (iabs(itype(i)).eq.20) then
5542 itori=itortyp(itype(i-2))
5543 itori1=itortyp(itype(i-1))
5546 ! Regular cosine and sine terms
5547 do j=1,nterm(itori,itori1,iblock)
5548 v1ij=v1(j,itori,itori1,iblock)
5549 v2ij=v2(j,itori,itori1,iblock)
5552 etors=etors+v1ij*cosphi+v2ij*sinphi
5553 if (energy_dec) etors_ii=etors_ii+ &
5554 v1ij*cosphi+v2ij*sinphi
5555 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5559 ! E = SUM ----------------------------------- - v1
5560 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5562 cosphi=dcos(0.5d0*phii)
5563 sinphi=dsin(0.5d0*phii)
5564 do j=1,nlor(itori,itori1,iblock)
5565 vl1ij=vlor1(j,itori,itori1)
5566 vl2ij=vlor2(j,itori,itori1)
5567 vl3ij=vlor3(j,itori,itori1)
5568 pom=vl2ij*cosphi+vl3ij*sinphi
5569 pom1=1.0d0/(pom*pom+1.0d0)
5570 etors=etors+vl1ij*pom1
5571 if (energy_dec) etors_ii=etors_ii+ &
5574 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5576 ! Subtract the constant term
5577 etors=etors-v0(itori,itori1,iblock)
5578 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5579 'etor',i,etors_ii-v0(itori,itori1,iblock)
5581 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5582 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
5583 (v1(j,itori,itori1,iblock),j=1,6),&
5584 (v2(j,itori,itori1,iblock),j=1,6)
5585 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5586 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5588 ! 6/20/98 - dihedral angle constraints
5590 ! do i=1,ndih_constr
5591 do i=idihconstr_start,idihconstr_end
5592 itori=idih_constr(i)
5594 difi=pinorm(phii-phi0(i))
5595 if (difi.gt.drange(i)) then
5597 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5598 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5599 else if (difi.lt.-drange(i)) then
5601 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5602 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5606 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5607 !d & rad2deg*phi0(i), rad2deg*drange(i),
5608 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5610 !d write (iout,*) 'edihcnstr',edihcnstr
5613 !-----------------------------------------------------------------------------
5614 subroutine etor_d(etors_d)
5615 ! 6/23/01 Compute double torsional energy
5616 ! implicit real*8 (a-h,o-z)
5617 ! include 'DIMENSIONS'
5618 ! include 'COMMON.VAR'
5619 ! include 'COMMON.GEO'
5620 ! include 'COMMON.LOCAL'
5621 ! include 'COMMON.TORSION'
5622 ! include 'COMMON.INTERACT'
5623 ! include 'COMMON.DERIV'
5624 ! include 'COMMON.CHAIN'
5625 ! include 'COMMON.NAMES'
5626 ! include 'COMMON.IOUNITS'
5627 ! include 'COMMON.FFIELD'
5628 ! include 'COMMON.TORCNSTR'
5629 real(kind=8) :: etors_d
5632 integer :: i,j,k,l,itori,itori1,itori2,iblock
5633 real(kind=8) :: phii,phii1,gloci1,gloci2,&
5634 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
5635 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
5636 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
5637 ! Set lprn=.true. for debugging
5641 ! write(iout,*) "a tu??"
5642 do i=iphid_start,iphid_end
5643 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
5644 .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5645 itori=itortyp(itype(i-2))
5646 itori1=itortyp(itype(i-1))
5647 itori2=itortyp(itype(i))
5653 if (iabs(itype(i+1)).eq.20) iblock=2
5655 ! Regular cosine and sine terms
5656 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5657 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5658 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5659 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5660 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5661 cosphi1=dcos(j*phii)
5662 sinphi1=dsin(j*phii)
5663 cosphi2=dcos(j*phii1)
5664 sinphi2=dsin(j*phii1)
5665 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
5666 v2cij*cosphi2+v2sij*sinphi2
5667 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5668 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5670 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5672 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5673 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5674 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5675 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5676 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5677 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5678 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5679 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5680 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
5681 v1sdij*sinphi1p2+v2sdij*sinphi1m2
5682 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
5683 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5684 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
5685 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5688 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5689 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5692 end subroutine etor_d
5694 !-----------------------------------------------------------------------------
5695 subroutine eback_sc_corr(esccor)
5696 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
5697 ! conformational states; temporarily implemented as differences
5698 ! between UNRES torsional potentials (dependent on three types of
5699 ! residues) and the torsional potentials dependent on all 20 types
5700 ! of residues computed from AM1 energy surfaces of terminally-blocked
5701 ! amino-acid residues.
5702 ! implicit real*8 (a-h,o-z)
5703 ! include 'DIMENSIONS'
5704 ! include 'COMMON.VAR'
5705 ! include 'COMMON.GEO'
5706 ! include 'COMMON.LOCAL'
5707 ! include 'COMMON.TORSION'
5708 ! include 'COMMON.SCCOR'
5709 ! include 'COMMON.INTERACT'
5710 ! include 'COMMON.DERIV'
5711 ! include 'COMMON.CHAIN'
5712 ! include 'COMMON.NAMES'
5713 ! include 'COMMON.IOUNITS'
5714 ! include 'COMMON.FFIELD'
5715 ! include 'COMMON.CONTROL'
5716 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
5719 integer :: i,interty,j,isccori,isccori1,intertyp
5720 ! Set lprn=.true. for debugging
5723 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5725 do i=itau_start,itau_end
5726 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5728 isccori=isccortyp(itype(i-2))
5729 isccori1=isccortyp(itype(i-1))
5731 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5733 do intertyp=1,3 !intertyp
5734 !c Added 09 May 2012 (Adasko)
5735 !c Intertyp means interaction type of backbone mainchain correlation:
5736 ! 1 = SC...Ca...Ca...Ca
5737 ! 2 = Ca...Ca...Ca...SC
5738 ! 3 = SC...Ca...Ca...SCi
5740 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. &
5741 (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or. &
5742 (itype(i-1).eq.ntyp1))) &
5743 .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) &
5744 .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1) &
5745 .or.(itype(i).eq.ntyp1))) &
5746 .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. &
5747 (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. &
5748 (itype(i-3).eq.ntyp1)))) cycle
5749 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5750 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1)) &
5752 do j=1,nterm_sccor(isccori,isccori1)
5753 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5754 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5755 cosphi=dcos(j*tauangle(intertyp,i))
5756 sinphi=dsin(j*tauangle(intertyp,i))
5757 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5758 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5760 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5761 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5763 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5764 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,&
5765 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
5766 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5767 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5772 end subroutine eback_sc_corr
5773 !-----------------------------------------------------------------------------
5774 subroutine multibody(ecorr)
5775 ! This subroutine calculates multi-body contributions to energy following
5776 ! the idea of Skolnick et al. If side chains I and J make a contact and
5777 ! at the same time side chains I+1 and J+1 make a contact, an extra
5778 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5779 ! implicit real*8 (a-h,o-z)
5780 ! include 'DIMENSIONS'
5781 ! include 'COMMON.IOUNITS'
5782 ! include 'COMMON.DERIV'
5783 ! include 'COMMON.INTERACT'
5784 ! include 'COMMON.CONTACTS'
5785 real(kind=8),dimension(3) :: gx,gx1
5787 real(kind=8) :: ecorr
5788 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
5789 ! Set lprn=.true. for debugging
5793 write (iout,'(a)') 'Contact function values:'
5795 write (iout,'(i2,20(1x,i2,f10.5))') &
5796 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5801 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
5802 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
5814 num_conti=num_cont(i)
5815 num_conti1=num_cont(i1)
5820 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5821 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5822 !d & ' ishift=',ishift
5823 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5824 ! The system gains extra energy.
5825 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5826 endif ! j1==j+-ishift
5834 end subroutine multibody
5835 !-----------------------------------------------------------------------------
5836 real(kind=8) function esccorr(i,j,k,l,jj,kk)
5837 ! implicit real*8 (a-h,o-z)
5838 ! include 'DIMENSIONS'
5839 ! include 'COMMON.IOUNITS'
5840 ! include 'COMMON.DERIV'
5841 ! include 'COMMON.INTERACT'
5842 ! include 'COMMON.CONTACTS'
5843 real(kind=8),dimension(3) :: gx,gx1
5845 integer :: i,j,k,l,jj,kk,m,ll
5846 real(kind=8) :: eij,ekl
5850 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5851 ! Calculate the multi-body contribution to energy.
5852 ! Calculate multi-body contributions to the gradient.
5853 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5854 !d & k,l,(gacont(m,kk,k),m=1,3)
5856 gx(m) =ekl*gacont(m,jj,i)
5857 gx1(m)=eij*gacont(m,kk,k)
5858 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5859 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5860 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5861 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5865 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5870 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5875 end function esccorr
5876 !-----------------------------------------------------------------------------
5877 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5878 ! This subroutine calculates multi-body contributions to hydrogen-bonding
5879 ! implicit real*8 (a-h,o-z)
5880 ! include 'DIMENSIONS'
5881 ! include 'COMMON.IOUNITS'
5884 ! integer :: maxconts !max_cont=maxconts =nres/4
5885 integer,parameter :: max_dim=26
5886 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5887 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
5888 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
5889 !el common /przechowalnia/ zapas
5890 integer :: status(MPI_STATUS_SIZE)
5891 integer,dimension((nres/4)*2) :: req !maxconts*2
5892 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
5894 ! include 'COMMON.SETUP'
5895 ! include 'COMMON.FFIELD'
5896 ! include 'COMMON.DERIV'
5897 ! include 'COMMON.INTERACT'
5898 ! include 'COMMON.CONTACTS'
5899 ! include 'COMMON.CONTROL'
5900 ! include 'COMMON.LOCAL'
5901 real(kind=8),dimension(3) :: gx,gx1
5902 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
5903 logical :: lprn,ldone
5905 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
5906 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
5908 ! Set lprn=.true. for debugging
5912 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
5915 if (nfgtasks.le.1) goto 30
5917 write (iout,'(a)') 'Contact function values before RECEIVE:'
5919 write (iout,'(2i3,50(1x,i2,f5.2))') &
5920 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
5925 do i=1,ntask_cont_from
5928 do i=1,ntask_cont_to
5931 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5933 ! Make the list of contacts to send to send to other procesors
5934 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5936 do i=iturn3_start,iturn3_end
5937 ! write (iout,*) "make contact list turn3",i," num_cont",
5939 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5941 do i=iturn4_start,iturn4_end
5942 ! write (iout,*) "make contact list turn4",i," num_cont",
5944 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5948 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
5950 do j=1,num_cont_hb(i)
5953 iproc=iint_sent_local(k,jjc,ii)
5954 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5955 if (iproc.gt.0) then
5956 ncont_sent(iproc)=ncont_sent(iproc)+1
5957 nn=ncont_sent(iproc)
5959 zapas(2,nn,iproc)=jjc
5960 zapas(3,nn,iproc)=facont_hb(j,i)
5961 zapas(4,nn,iproc)=ees0p(j,i)
5962 zapas(5,nn,iproc)=ees0m(j,i)
5963 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5964 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5965 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5966 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5967 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5968 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5969 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5970 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5971 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5972 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5973 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
5974 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
5975 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
5976 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
5977 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
5978 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
5979 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
5980 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
5981 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
5982 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
5983 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
5990 "Numbers of contacts to be sent to other processors",&
5991 (ncont_sent(i),i=1,ntask_cont_to)
5992 write (iout,*) "Contacts sent"
5993 do ii=1,ntask_cont_to
5995 iproc=itask_cont_to(ii)
5996 write (iout,*) nn," contacts to processor",iproc,&
5997 " of CONT_TO_COMM group"
5999 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6007 CorrelID1=nfgtasks+fg_rank+1
6009 ! Receive the numbers of needed contacts from other processors
6010 do ii=1,ntask_cont_from
6011 iproc=itask_cont_from(ii)
6013 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
6014 FG_COMM,req(ireq),IERR)
6016 ! write (iout,*) "IRECV ended"
6018 ! Send the number of contacts needed by other processors
6019 do ii=1,ntask_cont_to
6020 iproc=itask_cont_to(ii)
6022 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
6023 FG_COMM,req(ireq),IERR)
6025 ! write (iout,*) "ISEND ended"
6026 ! write (iout,*) "number of requests (nn)",ireq
6029 call MPI_Waitall(ireq,req,status_array,ierr)
6031 ! & "Numbers of contacts to be received from other processors",
6032 ! & (ncont_recv(i),i=1,ntask_cont_from)
6036 do ii=1,ntask_cont_from
6037 iproc=itask_cont_from(ii)
6039 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
6040 ! & " of CONT_TO_COMM group"
6044 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
6045 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6046 ! write (iout,*) "ireq,req",ireq,req(ireq)
6049 ! Send the contacts to processors that need them
6050 do ii=1,ntask_cont_to
6051 iproc=itask_cont_to(ii)
6053 ! write (iout,*) nn," contacts to processor",iproc,
6054 ! & " of CONT_TO_COMM group"
6057 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
6058 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6059 ! write (iout,*) "ireq,req",ireq,req(ireq)
6061 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6065 ! write (iout,*) "number of requests (contacts)",ireq
6066 ! write (iout,*) "req",(req(i),i=1,4)
6069 call MPI_Waitall(ireq,req,status_array,ierr)
6070 do iii=1,ntask_cont_from
6071 iproc=itask_cont_from(iii)
6074 write (iout,*) "Received",nn," contacts from processor",iproc,&
6075 " of CONT_FROM_COMM group"
6078 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6083 ii=zapas_recv(1,i,iii)
6084 ! Flag the received contacts to prevent double-counting
6085 jj=-zapas_recv(2,i,iii)
6086 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6088 nnn=num_cont_hb(ii)+1
6091 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6092 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6093 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6094 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6095 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6096 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6097 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6098 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6099 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6100 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6101 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6102 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6103 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6104 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6105 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6106 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6107 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6108 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6109 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6110 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6111 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6112 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6113 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6114 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6119 write (iout,'(a)') 'Contact function values after receive:'
6121 write (iout,'(2i3,50(1x,i3,f5.2))') &
6122 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6130 write (iout,'(a)') 'Contact function values:'
6132 write (iout,'(2i3,50(1x,i3,f5.2))') &
6133 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6139 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6140 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6141 ! Remove the loop below after debugging !!!
6148 ! Calculate the local-electrostatic correlation terms
6149 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6151 num_conti=num_cont_hb(i)
6152 num_conti1=num_cont_hb(i+1)
6159 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
6160 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
6161 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
6162 .or. j.lt.0 .and. j1.gt.0) .and. &
6163 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6164 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6165 ! The system gains extra energy.
6166 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6167 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
6168 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6170 else if (j1.eq.j) then
6171 ! Contacts I-J and I-(J+1) occur simultaneously.
6172 ! The system loses extra energy.
6173 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6178 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6179 ! & ' jj=',jj,' kk=',kk
6181 ! Contacts I-J and (I+1)-J occur simultaneously.
6182 ! The system loses extra energy.
6183 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6189 end subroutine multibody_hb
6190 !-----------------------------------------------------------------------------
6191 subroutine add_hb_contact(ii,jj,itask)
6192 ! implicit real*8 (a-h,o-z)
6193 ! include "DIMENSIONS"
6194 ! include "COMMON.IOUNITS"
6195 ! include "COMMON.CONTACTS"
6196 ! integer,parameter :: maxconts=nres/4
6197 integer,parameter :: max_dim=26
6198 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6199 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
6200 ! common /przechowalnia/ zapas
6201 integer :: i,j,ii,jj,iproc,nn,jjc
6202 integer,dimension(4) :: itask
6203 ! write (iout,*) "itask",itask
6206 if (iproc.gt.0) then
6207 do j=1,num_cont_hb(ii)
6209 ! write (iout,*) "i",ii," j",jj," jjc",jjc
6211 ncont_sent(iproc)=ncont_sent(iproc)+1
6212 nn=ncont_sent(iproc)
6213 zapas(1,nn,iproc)=ii
6214 zapas(2,nn,iproc)=jjc
6215 zapas(3,nn,iproc)=facont_hb(j,ii)
6216 zapas(4,nn,iproc)=ees0p(j,ii)
6217 zapas(5,nn,iproc)=ees0m(j,ii)
6218 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6219 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6220 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6221 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6222 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6223 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6224 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6225 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6226 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6227 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6228 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6229 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6230 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6231 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6232 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6233 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6234 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6235 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6236 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6237 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6238 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6245 end subroutine add_hb_contact
6246 !-----------------------------------------------------------------------------
6247 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
6248 ! This subroutine calculates multi-body contributions to hydrogen-bonding
6249 ! implicit real*8 (a-h,o-z)
6250 ! include 'DIMENSIONS'
6251 ! include 'COMMON.IOUNITS'
6252 integer,parameter :: max_dim=70
6255 ! integer :: maxconts !max_cont=maxconts=nres/4
6256 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6257 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
6258 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6259 ! common /przechowalnia/ zapas
6260 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
6261 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
6264 ! include 'COMMON.SETUP'
6265 ! include 'COMMON.FFIELD'
6266 ! include 'COMMON.DERIV'
6267 ! include 'COMMON.LOCAL'
6268 ! include 'COMMON.INTERACT'
6269 ! include 'COMMON.CONTACTS'
6270 ! include 'COMMON.CHAIN'
6271 ! include 'COMMON.CONTROL'
6272 real(kind=8),dimension(3) :: gx,gx1
6273 integer,dimension(nres) :: num_cont_hb_old
6274 logical :: lprn,ldone
6275 !EL double precision eello4,eello5,eelo6,eello_turn6
6276 !EL external eello4,eello5,eello6,eello_turn6
6278 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
6279 j1,jp1,i1,num_conti1
6280 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
6281 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
6283 ! Set lprn=.true. for debugging
6288 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
6290 num_cont_hb_old(i)=num_cont_hb(i)
6294 if (nfgtasks.le.1) goto 30
6296 write (iout,'(a)') 'Contact function values before RECEIVE:'
6298 write (iout,'(2i3,50(1x,i2,f5.2))') &
6299 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6304 do i=1,ntask_cont_from
6307 do i=1,ntask_cont_to
6310 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6312 ! Make the list of contacts to send to send to other procesors
6313 do i=iturn3_start,iturn3_end
6314 ! write (iout,*) "make contact list turn3",i," num_cont",
6316 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6318 do i=iturn4_start,iturn4_end
6319 ! write (iout,*) "make contact list turn4",i," num_cont",
6321 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6325 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
6327 do j=1,num_cont_hb(i)
6330 iproc=iint_sent_local(k,jjc,ii)
6331 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6332 if (iproc.ne.0) then
6333 ncont_sent(iproc)=ncont_sent(iproc)+1
6334 nn=ncont_sent(iproc)
6336 zapas(2,nn,iproc)=jjc
6337 zapas(3,nn,iproc)=d_cont(j,i)
6341 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6346 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6354 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6365 "Numbers of contacts to be sent to other processors",&
6366 (ncont_sent(i),i=1,ntask_cont_to)
6367 write (iout,*) "Contacts sent"
6368 do ii=1,ntask_cont_to
6370 iproc=itask_cont_to(ii)
6371 write (iout,*) nn," contacts to processor",iproc,&
6372 " of CONT_TO_COMM group"
6374 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6382 CorrelID1=nfgtasks+fg_rank+1
6384 ! Receive the numbers of needed contacts from other processors
6385 do ii=1,ntask_cont_from
6386 iproc=itask_cont_from(ii)
6388 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
6389 FG_COMM,req(ireq),IERR)
6391 ! write (iout,*) "IRECV ended"
6393 ! Send the number of contacts needed by other processors
6394 do ii=1,ntask_cont_to
6395 iproc=itask_cont_to(ii)
6397 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
6398 FG_COMM,req(ireq),IERR)
6400 ! write (iout,*) "ISEND ended"
6401 ! write (iout,*) "number of requests (nn)",ireq
6404 call MPI_Waitall(ireq,req,status_array,ierr)
6406 ! & "Numbers of contacts to be received from other processors",
6407 ! & (ncont_recv(i),i=1,ntask_cont_from)
6411 do ii=1,ntask_cont_from
6412 iproc=itask_cont_from(ii)
6414 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
6415 ! & " of CONT_TO_COMM group"
6419 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
6420 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6421 ! write (iout,*) "ireq,req",ireq,req(ireq)
6424 ! Send the contacts to processors that need them
6425 do ii=1,ntask_cont_to
6426 iproc=itask_cont_to(ii)
6428 ! write (iout,*) nn," contacts to processor",iproc,
6429 ! & " of CONT_TO_COMM group"
6432 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
6433 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6434 ! write (iout,*) "ireq,req",ireq,req(ireq)
6436 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6440 ! write (iout,*) "number of requests (contacts)",ireq
6441 ! write (iout,*) "req",(req(i),i=1,4)
6444 call MPI_Waitall(ireq,req,status_array,ierr)
6445 do iii=1,ntask_cont_from
6446 iproc=itask_cont_from(iii)
6449 write (iout,*) "Received",nn," contacts from processor",iproc,&
6450 " of CONT_FROM_COMM group"
6453 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6458 ii=zapas_recv(1,i,iii)
6459 ! Flag the received contacts to prevent double-counting
6460 jj=-zapas_recv(2,i,iii)
6461 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6463 nnn=num_cont_hb(ii)+1
6466 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6470 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6475 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6483 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6492 write (iout,'(a)') 'Contact function values after receive:'
6494 write (iout,'(2i3,50(1x,i3,5f6.3))') &
6495 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
6496 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6503 write (iout,'(a)') 'Contact function values:'
6505 write (iout,'(2i3,50(1x,i2,5f6.3))') &
6506 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
6507 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6514 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6515 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6516 ! Remove the loop below after debugging !!!
6523 ! Calculate the dipole-dipole interaction energies
6524 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6525 do i=iatel_s,iatel_e+1
6526 num_conti=num_cont_hb(i)
6535 ! Calculate the local-electrostatic correlation terms
6536 ! write (iout,*) "gradcorr5 in eello5 before loop"
6538 ! write (iout,'(i5,3f10.5)')
6539 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6541 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6542 ! write (iout,*) "corr loop i",i
6544 num_conti=num_cont_hb(i)
6545 num_conti1=num_cont_hb(i+1)
6552 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6553 ! & ' jj=',jj,' kk=',kk
6554 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
6555 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
6556 .or. j.lt.0 .and. j1.gt.0) .and. &
6557 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6558 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6559 ! The system gains extra energy.
6561 sqd1=dsqrt(d_cont(jj,i))
6562 sqd2=dsqrt(d_cont(kk,i1))
6563 sred_geom = sqd1*sqd2
6564 IF (sred_geom.lt.cutoff_corr) THEN
6565 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
6567 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6568 !d & ' jj=',jj,' kk=',kk
6569 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6570 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6572 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6573 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6576 !d write (iout,*) 'sred_geom=',sred_geom,
6577 !d & ' ekont=',ekont,' fprim=',fprimcont,
6578 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6579 !d write (iout,*) "g_contij",g_contij
6580 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6581 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6582 call calc_eello(i,jp,i+1,jp1,jj,kk)
6583 if (wcorr4.gt.0.0d0) &
6584 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6585 if (energy_dec.and.wcorr4.gt.0.0d0) &
6586 write (iout,'(a6,4i5,0pf7.3)') &
6587 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6588 ! write (iout,*) "gradcorr5 before eello5"
6590 ! write (iout,'(i5,3f10.5)')
6591 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6593 if (wcorr5.gt.0.0d0) &
6594 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6595 ! write (iout,*) "gradcorr5 after eello5"
6597 ! write (iout,'(i5,3f10.5)')
6598 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6600 if (energy_dec.and.wcorr5.gt.0.0d0) &
6601 write (iout,'(a6,4i5,0pf7.3)') &
6602 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6603 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6604 !d write(2,*)'ijkl',i,jp,i+1,jp1
6605 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
6606 .or. wturn6.eq.0.0d0))then
6607 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6608 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6609 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
6610 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6611 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6612 !d & 'ecorr6=',ecorr6
6613 !d write (iout,'(4e15.5)') sred_geom,
6614 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6615 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6616 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6617 else if (wturn6.gt.0.0d0 &
6618 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6619 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6620 eturn6=eturn6+eello_turn6(i,jj,kk)
6621 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
6622 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6623 !d write (2,*) 'multibody_eello:eturn6',eturn6
6632 num_cont_hb(i)=num_cont_hb_old(i)
6634 ! write (iout,*) "gradcorr5 in eello5"
6636 ! write (iout,'(i5,3f10.5)')
6637 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6640 end subroutine multibody_eello
6641 !-----------------------------------------------------------------------------
6642 subroutine add_hb_contact_eello(ii,jj,itask)
6643 ! implicit real*8 (a-h,o-z)
6644 ! include "DIMENSIONS"
6645 ! include "COMMON.IOUNITS"
6646 ! include "COMMON.CONTACTS"
6647 ! integer,parameter :: maxconts=nres/4
6648 integer,parameter :: max_dim=70
6649 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
6650 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6651 ! common /przechowalnia/ zapas
6653 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
6654 integer,dimension(4) ::itask
6655 ! write (iout,*) "itask",itask
6658 if (iproc.gt.0) then
6659 do j=1,num_cont_hb(ii)
6661 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6663 ncont_sent(iproc)=ncont_sent(iproc)+1
6664 nn=ncont_sent(iproc)
6665 zapas(1,nn,iproc)=ii
6666 zapas(2,nn,iproc)=jjc
6667 zapas(3,nn,iproc)=d_cont(j,ii)
6671 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6676 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6684 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6695 end subroutine add_hb_contact_eello
6696 !-----------------------------------------------------------------------------
6697 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6698 ! implicit real*8 (a-h,o-z)
6699 ! include 'DIMENSIONS'
6700 ! include 'COMMON.IOUNITS'
6701 ! include 'COMMON.DERIV'
6702 ! include 'COMMON.INTERACT'
6703 ! include 'COMMON.CONTACTS'
6704 real(kind=8),dimension(3) :: gx,gx1
6707 integer :: i,j,k,l,jj,kk,ll
6708 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
6709 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
6710 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl
6720 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6721 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6722 ! Following 4 lines for diagnostics.
6727 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6728 ! & 'Contacts ',i,j,
6729 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6730 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6732 ! Calculate the multi-body contribution to energy.
6733 ! ecorr=ecorr+ekont*ees
6734 ! Calculate multi-body contributions to the gradient.
6735 coeffpees0pij=coeffp*ees0pij
6736 coeffmees0mij=coeffm*ees0mij
6737 coeffpees0pkl=coeffp*ees0pkl
6738 coeffmees0mkl=coeffm*ees0mkl
6740 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6741 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
6742 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
6743 coeffmees0mkl*gacontm_hb1(ll,jj,i))
6744 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
6745 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
6746 coeffmees0mkl*gacontm_hb2(ll,jj,i))
6747 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6748 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
6749 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
6750 coeffmees0mij*gacontm_hb1(ll,kk,k))
6751 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
6752 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
6753 coeffmees0mij*gacontm_hb2(ll,kk,k))
6754 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
6755 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
6756 coeffmees0mkl*gacontm_hb3(ll,jj,i))
6757 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6758 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6759 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
6760 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
6761 coeffmees0mij*gacontm_hb3(ll,kk,k))
6762 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6763 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6764 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6769 !grad gradcorr(ll,m)=gradcorr(ll,m)+
6770 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
6771 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6772 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6777 !grad gradcorr(ll,m)=gradcorr(ll,m)+
6778 !grad & ees*eij*gacont_hbr(ll,kk,k)-
6779 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6780 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6783 ! write (iout,*) "ehbcorr",ekont*ees
6786 end function ehbcorr
6788 !-----------------------------------------------------------------------------
6789 subroutine dipole(i,j,jj)
6790 ! implicit real*8 (a-h,o-z)
6791 ! include 'DIMENSIONS'
6792 ! include 'COMMON.IOUNITS'
6793 ! include 'COMMON.CHAIN'
6794 ! include 'COMMON.FFIELD'
6795 ! include 'COMMON.DERIV'
6796 ! include 'COMMON.INTERACT'
6797 ! include 'COMMON.CONTACTS'
6798 ! include 'COMMON.TORSION'
6799 ! include 'COMMON.VAR'
6800 ! include 'COMMON.GEO'
6801 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
6802 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
6803 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
6805 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
6806 allocate(dipderx(3,5,4,maxconts,nres))
6809 iti1 = itortyp(itype(i+1))
6810 if (j.lt.nres-1) then
6811 itj1 = itortyp(itype(j+1))
6816 dipi(iii,1)=Ub2(iii,i)
6817 dipderi(iii)=Ub2der(iii,i)
6818 dipi(iii,2)=b1(iii,iti1)
6819 dipj(iii,1)=Ub2(iii,j)
6820 dipderj(iii)=Ub2der(iii,j)
6821 dipj(iii,2)=b1(iii,itj1)
6825 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6828 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6835 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
6839 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6844 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6845 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6847 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6849 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6851 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6854 end subroutine dipole
6856 !-----------------------------------------------------------------------------
6857 subroutine calc_eello(i,j,k,l,jj,kk)
6859 ! This subroutine computes matrices and vectors needed to calculate
6860 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
6863 ! implicit real*8 (a-h,o-z)
6864 ! include 'DIMENSIONS'
6865 ! include 'COMMON.IOUNITS'
6866 ! include 'COMMON.CHAIN'
6867 ! include 'COMMON.DERIV'
6868 ! include 'COMMON.INTERACT'
6869 ! include 'COMMON.CONTACTS'
6870 ! include 'COMMON.TORSION'
6871 ! include 'COMMON.VAR'
6872 ! include 'COMMON.GEO'
6873 ! include 'COMMON.FFIELD'
6874 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
6875 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
6876 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
6879 !el common /kutas/ lprn
6880 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6881 !d & ' jj=',jj,' kk=',kk
6882 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6883 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6884 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6887 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6888 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6891 call transpose2(aa1(1,1),aa1t(1,1))
6892 call transpose2(aa2(1,1),aa2t(1,1))
6895 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
6896 aa1tder(1,1,lll,kkk))
6897 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
6898 aa2tder(1,1,lll,kkk))
6902 ! parallel orientation of the two CA-CA-CA frames.
6904 iti=itortyp(itype(i))
6908 itk1=itortyp(itype(k+1))
6909 itj=itortyp(itype(j))
6910 if (l.lt.nres-1) then
6911 itl1=itortyp(itype(l+1))
6915 ! A1 kernel(j+1) A2T
6917 !d write (iout,'(3f10.5,5x,3f10.5)')
6918 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6920 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
6921 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
6922 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6923 ! Following matrices are needed only for 6-th order cumulants
6924 IF (wcorr6.gt.0.0d0) THEN
6925 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
6926 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
6927 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6928 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
6929 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
6930 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
6931 ADtEAderx(1,1,1,1,1,1))
6933 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
6934 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
6935 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
6936 ADtEA1derx(1,1,1,1,1,1))
6938 ! End 6-th order cumulants
6941 !d write (2,*) 'In calc_eello6'
6943 !d write (2,*) 'iii=',iii
6945 !d write (2,*) 'kkk=',kkk
6947 !d write (2,'(3(2f10.5),5x)')
6948 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6953 call transpose2(EUgder(1,1,k),auxmat(1,1))
6954 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6955 call transpose2(EUg(1,1,k),auxmat(1,1))
6956 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6957 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6961 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
6962 EAEAderx(1,1,lll,kkk,iii,1))
6966 ! A1T kernel(i+1) A2
6967 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
6968 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
6969 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6970 ! Following matrices are needed only for 6-th order cumulants
6971 IF (wcorr6.gt.0.0d0) THEN
6972 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
6973 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
6974 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6975 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
6976 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
6977 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
6978 ADtEAderx(1,1,1,1,1,2))
6979 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
6980 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
6981 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
6982 ADtEA1derx(1,1,1,1,1,2))
6984 ! End 6-th order cumulants
6985 call transpose2(EUgder(1,1,l),auxmat(1,1))
6986 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6987 call transpose2(EUg(1,1,l),auxmat(1,1))
6988 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6989 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6993 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
6994 EAEAderx(1,1,lll,kkk,iii,2))
6999 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7000 ! They are needed only when the fifth- or the sixth-order cumulants are
7002 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7003 call transpose2(AEA(1,1,1),auxmat(1,1))
7004 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7005 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7006 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7007 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7008 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7009 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7010 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7011 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7012 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7013 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7014 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7015 call transpose2(AEA(1,1,2),auxmat(1,1))
7016 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7017 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7018 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7019 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7020 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7021 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7022 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7023 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7024 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7025 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7026 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7027 ! Calculate the Cartesian derivatives of the vectors.
7031 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7032 call matvec2(auxmat(1,1),b1(1,iti),&
7033 AEAb1derx(1,lll,kkk,iii,1,1))
7034 call matvec2(auxmat(1,1),Ub2(1,i),&
7035 AEAb2derx(1,lll,kkk,iii,1,1))
7036 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
7037 AEAb1derx(1,lll,kkk,iii,2,1))
7038 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
7039 AEAb2derx(1,lll,kkk,iii,2,1))
7040 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7041 call matvec2(auxmat(1,1),b1(1,itj),&
7042 AEAb1derx(1,lll,kkk,iii,1,2))
7043 call matvec2(auxmat(1,1),Ub2(1,j),&
7044 AEAb2derx(1,lll,kkk,iii,1,2))
7045 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
7046 AEAb1derx(1,lll,kkk,iii,2,2))
7047 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
7048 AEAb2derx(1,lll,kkk,iii,2,2))
7055 ! Antiparallel orientation of the two CA-CA-CA frames.
7057 iti=itortyp(itype(i))
7061 itk1=itortyp(itype(k+1))
7062 itl=itortyp(itype(l))
7063 itj=itortyp(itype(j))
7064 if (j.lt.nres-1) then
7065 itj1=itortyp(itype(j+1))
7069 ! A2 kernel(j-1)T A1T
7070 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7071 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
7072 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7073 ! Following matrices are needed only for 6-th order cumulants
7074 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
7075 j.eq.i+4 .and. l.eq.i+3)) THEN
7076 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7077 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
7078 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7079 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7080 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
7081 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
7082 ADtEAderx(1,1,1,1,1,1))
7083 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7084 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
7085 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
7086 ADtEA1derx(1,1,1,1,1,1))
7088 ! End 6-th order cumulants
7089 call transpose2(EUgder(1,1,k),auxmat(1,1))
7090 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7091 call transpose2(EUg(1,1,k),auxmat(1,1))
7092 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7093 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7097 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7098 EAEAderx(1,1,lll,kkk,iii,1))
7102 ! A2T kernel(i+1)T A1
7103 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7104 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
7105 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7106 ! Following matrices are needed only for 6-th order cumulants
7107 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
7108 j.eq.i+4 .and. l.eq.i+3)) THEN
7109 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7110 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
7111 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7112 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7113 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
7114 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
7115 ADtEAderx(1,1,1,1,1,2))
7116 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7117 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
7118 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
7119 ADtEA1derx(1,1,1,1,1,2))
7121 ! End 6-th order cumulants
7122 call transpose2(EUgder(1,1,j),auxmat(1,1))
7123 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7124 call transpose2(EUg(1,1,j),auxmat(1,1))
7125 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7126 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7130 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7131 EAEAderx(1,1,lll,kkk,iii,2))
7136 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7137 ! They are needed only when the fifth- or the sixth-order cumulants are
7139 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
7140 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7141 call transpose2(AEA(1,1,1),auxmat(1,1))
7142 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7143 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7144 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7145 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7146 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7147 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7148 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7149 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7150 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7151 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7152 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7153 call transpose2(AEA(1,1,2),auxmat(1,1))
7154 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7155 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7156 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7157 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7158 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7159 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7160 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7161 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7162 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7163 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7164 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7165 ! Calculate the Cartesian derivatives of the vectors.
7169 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7170 call matvec2(auxmat(1,1),b1(1,iti),&
7171 AEAb1derx(1,lll,kkk,iii,1,1))
7172 call matvec2(auxmat(1,1),Ub2(1,i),&
7173 AEAb2derx(1,lll,kkk,iii,1,1))
7174 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
7175 AEAb1derx(1,lll,kkk,iii,2,1))
7176 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
7177 AEAb2derx(1,lll,kkk,iii,2,1))
7178 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7179 call matvec2(auxmat(1,1),b1(1,itl),&
7180 AEAb1derx(1,lll,kkk,iii,1,2))
7181 call matvec2(auxmat(1,1),Ub2(1,l),&
7182 AEAb2derx(1,lll,kkk,iii,1,2))
7183 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
7184 AEAb1derx(1,lll,kkk,iii,2,2))
7185 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
7186 AEAb2derx(1,lll,kkk,iii,2,2))
7194 end subroutine calc_eello
7195 !-----------------------------------------------------------------------------
7196 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
7201 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
7202 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
7203 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
7204 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
7205 integer :: iii,kkk,lll
7208 !el common /kutas/ lprn
7209 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7211 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
7214 !d if (lprn) write (2,*) 'In kernel'
7216 !d if (lprn) write (2,*) 'kkk=',kkk
7218 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
7219 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7221 !d write (2,*) 'lll=',lll
7222 !d write (2,*) 'iii=1'
7224 !d write (2,'(3(2f10.5),5x)')
7225 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7228 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
7229 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7231 !d write (2,*) 'lll=',lll
7232 !d write (2,*) 'iii=2'
7234 !d write (2,'(3(2f10.5),5x)')
7235 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7241 end subroutine kernel
7242 !-----------------------------------------------------------------------------
7243 real(kind=8) function eello4(i,j,k,l,jj,kk)
7244 ! implicit real*8 (a-h,o-z)
7245 ! include 'DIMENSIONS'
7246 ! include 'COMMON.IOUNITS'
7247 ! include 'COMMON.CHAIN'
7248 ! include 'COMMON.DERIV'
7249 ! include 'COMMON.INTERACT'
7250 ! include 'COMMON.CONTACTS'
7251 ! include 'COMMON.TORSION'
7252 ! include 'COMMON.VAR'
7253 ! include 'COMMON.GEO'
7254 real(kind=8),dimension(2,2) :: pizda
7255 real(kind=8),dimension(3) :: ggg1,ggg2
7256 real(kind=8) :: eel4,glongij,glongkl
7257 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
7258 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7262 !d print *,'eello4:',i,j,k,l,jj,kk
7263 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
7264 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
7265 !old eij=facont_hb(jj,i)
7266 !old ekl=facont_hb(kk,k)
7268 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7269 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7270 gcorr_loc(k-1)=gcorr_loc(k-1) &
7271 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7273 gcorr_loc(l-1)=gcorr_loc(l-1) &
7274 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7276 gcorr_loc(j-1)=gcorr_loc(j-1) &
7277 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7282 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
7283 -EAEAderx(2,2,lll,kkk,iii,1)
7284 !d derx(lll,kkk,iii)=0.0d0
7288 !d gcorr_loc(l-1)=0.0d0
7289 !d gcorr_loc(j-1)=0.0d0
7290 !d gcorr_loc(k-1)=0.0d0
7292 !d write (iout,*)'Contacts have occurred for peptide groups',
7293 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
7294 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7295 if (j.lt.nres-1) then
7302 if (l.lt.nres-1) then
7310 !grad ggg1(ll)=eel4*g_contij(ll,1)
7311 !grad ggg2(ll)=eel4*g_contij(ll,2)
7312 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7313 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7314 !grad ghalf=0.5d0*ggg1(ll)
7315 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7316 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7317 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7318 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7319 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7320 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7321 !grad ghalf=0.5d0*ggg2(ll)
7322 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7323 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7324 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7325 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7326 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7327 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7331 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7336 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7341 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7346 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7350 !d write (2,*) iii,gcorr_loc(iii)
7353 !d write (2,*) 'ekont',ekont
7354 !d write (iout,*) 'eello4',ekont*eel4
7357 !-----------------------------------------------------------------------------
7358 real(kind=8) function eello5(i,j,k,l,jj,kk)
7359 ! implicit real*8 (a-h,o-z)
7360 ! include 'DIMENSIONS'
7361 ! include 'COMMON.IOUNITS'
7362 ! include 'COMMON.CHAIN'
7363 ! include 'COMMON.DERIV'
7364 ! include 'COMMON.INTERACT'
7365 ! include 'COMMON.CONTACTS'
7366 ! include 'COMMON.TORSION'
7367 ! include 'COMMON.VAR'
7368 ! include 'COMMON.GEO'
7369 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
7370 real(kind=8),dimension(2) :: vv
7371 real(kind=8),dimension(3) :: ggg1,ggg2
7372 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
7373 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
7374 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
7375 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7380 ! /l\ / \ \ / \ / \ / C
7381 ! / \ / \ \ / \ / \ / C
7382 ! j| o |l1 | o | o| o | | o |o C
7383 ! \ |/k\| |/ \| / |/ \| |/ \| C
7384 ! \i/ \ / \ / / \ / \ C
7386 ! (I) (II) (III) (IV) C
7388 ! eello5_1 eello5_2 eello5_3 eello5_4 C
7390 ! Antiparallel chains C
7393 ! /j\ / \ \ / \ / \ / C
7394 ! / \ / \ \ / \ / \ / C
7395 ! j1| o |l | o | o| o | | o |o C
7396 ! \ |/k\| |/ \| / |/ \| |/ \| C
7397 ! \i/ \ / \ / / \ / \ C
7399 ! (I) (II) (III) (IV) C
7401 ! eello5_1 eello5_2 eello5_3 eello5_4 C
7403 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
7405 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7406 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7411 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7413 itk=itortyp(itype(k))
7414 itl=itortyp(itype(l))
7415 itj=itortyp(itype(j))
7420 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7421 !d & eel5_3_num,eel5_4_num)
7425 derx(lll,kkk,iii)=0.0d0
7429 !d eij=facont_hb(jj,i)
7430 !d ekl=facont_hb(kk,k)
7432 !d write (iout,*)'Contacts have occurred for peptide groups',
7433 !d & i,j,' fcont:',eij,' eij',' and ',k,l
7435 ! Contribution from the graph I.
7436 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7437 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7438 call transpose2(EUg(1,1,k),auxmat(1,1))
7439 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7440 vv(1)=pizda(1,1)-pizda(2,2)
7441 vv(2)=pizda(1,2)+pizda(2,1)
7442 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
7443 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7444 ! Explicit gradient in virtual-dihedral angles.
7445 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
7446 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
7447 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7448 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7449 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7450 vv(1)=pizda(1,1)-pizda(2,2)
7451 vv(2)=pizda(1,2)+pizda(2,1)
7452 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7453 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
7454 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7455 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7456 vv(1)=pizda(1,1)-pizda(2,2)
7457 vv(2)=pizda(1,2)+pizda(2,1)
7459 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7460 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
7461 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7463 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7464 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
7465 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7467 ! Cartesian gradient
7471 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
7473 vv(1)=pizda(1,1)-pizda(2,2)
7474 vv(2)=pizda(1,2)+pizda(2,1)
7475 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7476 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
7477 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7483 ! Contribution from graph II
7484 call transpose2(EE(1,1,itk),auxmat(1,1))
7485 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7486 vv(1)=pizda(1,1)+pizda(2,2)
7487 vv(2)=pizda(2,1)-pizda(1,2)
7488 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
7489 -0.5d0*scalar2(vv(1),Ctobr(1,k))
7490 ! Explicit gradient in virtual-dihedral angles.
7491 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7492 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7493 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7494 vv(1)=pizda(1,1)+pizda(2,2)
7495 vv(2)=pizda(2,1)-pizda(1,2)
7497 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7498 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
7499 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7501 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7502 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
7503 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7505 ! Cartesian gradient
7509 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7511 vv(1)=pizda(1,1)+pizda(2,2)
7512 vv(2)=pizda(2,1)-pizda(1,2)
7513 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7514 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
7515 -0.5d0*scalar2(vv(1),Ctobr(1,k))
7523 ! Parallel orientation
7524 ! Contribution from graph III
7525 call transpose2(EUg(1,1,l),auxmat(1,1))
7526 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7527 vv(1)=pizda(1,1)-pizda(2,2)
7528 vv(2)=pizda(1,2)+pizda(2,1)
7529 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
7530 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7531 ! Explicit gradient in virtual-dihedral angles.
7532 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7533 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
7534 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7535 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7536 vv(1)=pizda(1,1)-pizda(2,2)
7537 vv(2)=pizda(1,2)+pizda(2,1)
7538 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7539 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
7540 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7541 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7542 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7543 vv(1)=pizda(1,1)-pizda(2,2)
7544 vv(2)=pizda(1,2)+pizda(2,1)
7545 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7546 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
7547 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7548 ! Cartesian gradient
7552 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
7554 vv(1)=pizda(1,1)-pizda(2,2)
7555 vv(2)=pizda(1,2)+pizda(2,1)
7556 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7557 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
7558 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7563 ! Contribution from graph IV
7565 call transpose2(EE(1,1,itl),auxmat(1,1))
7566 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7567 vv(1)=pizda(1,1)+pizda(2,2)
7568 vv(2)=pizda(2,1)-pizda(1,2)
7569 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
7570 -0.5d0*scalar2(vv(1),Ctobr(1,l))
7571 ! Explicit gradient in virtual-dihedral angles.
7572 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7573 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7574 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7575 vv(1)=pizda(1,1)+pizda(2,2)
7576 vv(2)=pizda(2,1)-pizda(1,2)
7577 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7578 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
7579 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7580 ! Cartesian gradient
7584 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7586 vv(1)=pizda(1,1)+pizda(2,2)
7587 vv(2)=pizda(2,1)-pizda(1,2)
7588 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7589 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
7590 -0.5d0*scalar2(vv(1),Ctobr(1,l))
7595 ! Antiparallel orientation
7596 ! Contribution from graph III
7598 call transpose2(EUg(1,1,j),auxmat(1,1))
7599 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7600 vv(1)=pizda(1,1)-pizda(2,2)
7601 vv(2)=pizda(1,2)+pizda(2,1)
7602 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
7603 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7604 ! Explicit gradient in virtual-dihedral angles.
7605 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7606 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
7607 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7608 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7609 vv(1)=pizda(1,1)-pizda(2,2)
7610 vv(2)=pizda(1,2)+pizda(2,1)
7611 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7612 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
7613 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7614 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7615 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7616 vv(1)=pizda(1,1)-pizda(2,2)
7617 vv(2)=pizda(1,2)+pizda(2,1)
7618 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7619 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
7620 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7621 ! Cartesian gradient
7625 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
7627 vv(1)=pizda(1,1)-pizda(2,2)
7628 vv(2)=pizda(1,2)+pizda(2,1)
7629 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
7630 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
7631 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7636 ! Contribution from graph IV
7638 call transpose2(EE(1,1,itj),auxmat(1,1))
7639 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7640 vv(1)=pizda(1,1)+pizda(2,2)
7641 vv(2)=pizda(2,1)-pizda(1,2)
7642 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
7643 -0.5d0*scalar2(vv(1),Ctobr(1,j))
7644 ! Explicit gradient in virtual-dihedral angles.
7645 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7646 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7647 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7648 vv(1)=pizda(1,1)+pizda(2,2)
7649 vv(2)=pizda(2,1)-pizda(1,2)
7650 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7651 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
7652 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7653 ! Cartesian gradient
7657 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7659 vv(1)=pizda(1,1)+pizda(2,2)
7660 vv(2)=pizda(2,1)-pizda(1,2)
7661 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
7662 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
7663 -0.5d0*scalar2(vv(1),Ctobr(1,j))
7669 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7670 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7671 !d write (2,*) 'ijkl',i,j,k,l
7672 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7673 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
7675 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7676 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7677 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7678 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7679 if (j.lt.nres-1) then
7686 if (l.lt.nres-1) then
7696 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7697 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
7698 ! summed up outside the subrouine as for the other subroutines
7699 ! handling long-range interactions. The old code is commented out
7700 ! with "cgrad" to keep track of changes.
7702 !grad ggg1(ll)=eel5*g_contij(ll,1)
7703 !grad ggg2(ll)=eel5*g_contij(ll,2)
7704 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7705 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7706 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7707 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7708 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7709 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7710 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7711 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7713 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7714 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7715 !grad ghalf=0.5d0*ggg1(ll)
7717 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7718 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7719 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7720 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7721 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7722 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7723 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7724 !grad ghalf=0.5d0*ggg2(ll)
7726 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7727 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7728 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7729 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7730 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7731 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7736 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7737 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7742 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7743 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7749 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7754 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7758 !d write (2,*) iii,g_corr5_loc(iii)
7761 !d write (2,*) 'ekont',ekont
7762 !d write (iout,*) 'eello5',ekont*eel5
7765 !-----------------------------------------------------------------------------
7766 real(kind=8) function eello6(i,j,k,l,jj,kk)
7767 ! implicit real*8 (a-h,o-z)
7768 ! include 'DIMENSIONS'
7769 ! include 'COMMON.IOUNITS'
7770 ! include 'COMMON.CHAIN'
7771 ! include 'COMMON.DERIV'
7772 ! include 'COMMON.INTERACT'
7773 ! include 'COMMON.CONTACTS'
7774 ! include 'COMMON.TORSION'
7775 ! include 'COMMON.VAR'
7776 ! include 'COMMON.GEO'
7777 ! include 'COMMON.FFIELD'
7778 real(kind=8),dimension(3) :: ggg1,ggg2
7779 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
7781 real(kind=8) :: gradcorr6ij,gradcorr6kl
7782 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
7783 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7788 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7796 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7797 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7801 derx(lll,kkk,iii)=0.0d0
7805 !d eij=facont_hb(jj,i)
7806 !d ekl=facont_hb(kk,k)
7812 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7813 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7814 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7815 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7816 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7817 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7819 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7820 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7821 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7822 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7823 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7824 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7828 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7830 ! If turn contributions are considered, they will be handled separately.
7831 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7832 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7833 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7834 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7835 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7836 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7837 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7839 if (j.lt.nres-1) then
7846 if (l.lt.nres-1) then
7854 !grad ggg1(ll)=eel6*g_contij(ll,1)
7855 !grad ggg2(ll)=eel6*g_contij(ll,2)
7856 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7857 !grad ghalf=0.5d0*ggg1(ll)
7859 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7860 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7861 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7862 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7863 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7864 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7865 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7866 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7867 !grad ghalf=0.5d0*ggg2(ll)
7868 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7870 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7871 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7872 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7873 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7874 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7875 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7880 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7881 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7886 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7887 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7893 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7898 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7902 !d write (2,*) iii,g_corr6_loc(iii)
7905 !d write (2,*) 'ekont',ekont
7906 !d write (iout,*) 'eello6',ekont*eel6
7909 !-----------------------------------------------------------------------------
7910 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
7912 ! implicit real*8 (a-h,o-z)
7913 ! include 'DIMENSIONS'
7914 ! include 'COMMON.IOUNITS'
7915 ! include 'COMMON.CHAIN'
7916 ! include 'COMMON.DERIV'
7917 ! include 'COMMON.INTERACT'
7918 ! include 'COMMON.CONTACTS'
7919 ! include 'COMMON.TORSION'
7920 ! include 'COMMON.VAR'
7921 ! include 'COMMON.GEO'
7922 real(kind=8),dimension(2) :: vv,vv1
7923 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
7926 !el common /kutas/ lprn
7927 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
7928 real(kind=8) :: s1,s2,s3,s4,s5
7929 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7931 ! Parallel Antiparallel C
7937 ! \ j|/k\| / \ |/k\|l / C
7942 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7943 itk=itortyp(itype(k))
7944 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7945 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7946 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7947 call transpose2(EUgC(1,1,k),auxmat(1,1))
7948 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7949 vv1(1)=pizda1(1,1)-pizda1(2,2)
7950 vv1(2)=pizda1(1,2)+pizda1(2,1)
7951 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7952 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7953 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7954 s5=scalar2(vv(1),Dtobr2(1,i))
7955 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7956 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7957 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
7958 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
7959 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
7960 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
7961 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
7962 +scalar2(vv(1),Dtobr2der(1,i)))
7963 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7964 vv1(1)=pizda1(1,1)-pizda1(2,2)
7965 vv1(2)=pizda1(1,2)+pizda1(2,1)
7966 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7967 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7969 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
7970 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
7971 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
7972 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
7973 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7975 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
7976 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
7977 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
7978 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
7979 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7981 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7982 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7983 vv1(1)=pizda1(1,1)-pizda1(2,2)
7984 vv1(2)=pizda1(1,2)+pizda1(2,1)
7985 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
7986 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
7987 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
7988 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7997 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7998 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7999 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8000 call transpose2(EUgC(1,1,k),auxmat(1,1))
8001 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
8003 vv1(1)=pizda1(1,1)-pizda1(2,2)
8004 vv1(2)=pizda1(1,2)+pizda1(2,1)
8005 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8006 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
8007 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8008 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
8009 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8010 s5=scalar2(vv(1),Dtobr2(1,i))
8011 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8016 end function eello6_graph1
8017 !-----------------------------------------------------------------------------
8018 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
8020 ! implicit real*8 (a-h,o-z)
8021 ! include 'DIMENSIONS'
8022 ! include 'COMMON.IOUNITS'
8023 ! include 'COMMON.CHAIN'
8024 ! include 'COMMON.DERIV'
8025 ! include 'COMMON.INTERACT'
8026 ! include 'COMMON.CONTACTS'
8027 ! include 'COMMON.TORSION'
8028 ! include 'COMMON.VAR'
8029 ! include 'COMMON.GEO'
8031 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
8032 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8034 !el common /kutas/ lprn
8035 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
8036 real(kind=8) :: s2,s3,s4
8037 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8039 ! Parallel Antiparallel C
8045 ! \ j|/k\| \ |/k\|l C
8050 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8051 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8052 ! AL 7/4/01 s1 would occur in the sixth-order moment,
8053 ! but not in a cluster cumulant
8055 s1=dip(1,jj,i)*dip(1,kk,k)
8057 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8058 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8059 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8060 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8061 call transpose2(EUg(1,1,k),auxmat(1,1))
8062 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8063 vv(1)=pizda(1,1)-pizda(2,2)
8064 vv(2)=pizda(1,2)+pizda(2,1)
8065 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8066 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8068 eello6_graph2=-(s1+s2+s3+s4)
8070 eello6_graph2=-(s2+s3+s4)
8073 ! Derivatives in gamma(i-1)
8076 s1=dipderg(1,jj,i)*dip(1,kk,k)
8078 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8079 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8080 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8081 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8083 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8085 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8087 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8089 ! Derivatives in gamma(k-1)
8091 s1=dip(1,jj,i)*dipderg(1,kk,k)
8093 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8094 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8095 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8096 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8097 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8098 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8099 vv(1)=pizda(1,1)-pizda(2,2)
8100 vv(2)=pizda(1,2)+pizda(2,1)
8101 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8103 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8105 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8107 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8108 ! Derivatives in gamma(j-1) or gamma(l-1)
8111 s1=dipderg(3,jj,i)*dip(1,kk,k)
8113 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8114 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8115 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8116 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8117 vv(1)=pizda(1,1)-pizda(2,2)
8118 vv(2)=pizda(1,2)+pizda(2,1)
8119 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8122 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8124 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8127 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8128 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8130 ! Derivatives in gamma(l-1) or gamma(j-1)
8133 s1=dip(1,jj,i)*dipderg(3,kk,k)
8135 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8136 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8137 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8138 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8139 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8140 vv(1)=pizda(1,1)-pizda(2,2)
8141 vv(2)=pizda(1,2)+pizda(2,1)
8142 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8145 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8147 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8150 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8151 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8153 ! Cartesian derivatives.
8155 write (2,*) 'In eello6_graph2'
8157 write (2,*) 'iii=',iii
8159 write (2,*) 'kkk=',kkk
8161 write (2,'(3(2f10.5),5x)') &
8162 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8172 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8174 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8177 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
8179 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8180 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
8182 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8183 call transpose2(EUg(1,1,k),auxmat(1,1))
8184 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8186 vv(1)=pizda(1,1)-pizda(2,2)
8187 vv(2)=pizda(1,2)+pizda(2,1)
8188 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8189 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8191 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8193 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8196 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8198 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8204 end function eello6_graph2
8205 !-----------------------------------------------------------------------------
8206 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
8207 ! implicit real*8 (a-h,o-z)
8208 ! include 'DIMENSIONS'
8209 ! include 'COMMON.IOUNITS'
8210 ! include 'COMMON.CHAIN'
8211 ! include 'COMMON.DERIV'
8212 ! include 'COMMON.INTERACT'
8213 ! include 'COMMON.CONTACTS'
8214 ! include 'COMMON.TORSION'
8215 ! include 'COMMON.VAR'
8216 ! include 'COMMON.GEO'
8217 real(kind=8),dimension(2) :: vv,auxvec
8218 real(kind=8),dimension(2,2) :: pizda,auxmat
8220 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
8221 real(kind=8) :: s1,s2,s3,s4
8222 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8224 ! Parallel Antiparallel C
8230 ! j|/k\| / |/k\|l / C
8235 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8237 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
8238 ! energy moment and not to the cluster cumulant.
8239 iti=itortyp(itype(i))
8240 if (j.lt.nres-1) then
8241 itj1=itortyp(itype(j+1))
8245 itk=itortyp(itype(k))
8246 itk1=itortyp(itype(k+1))
8247 if (l.lt.nres-1) then
8248 itl1=itortyp(itype(l+1))
8253 s1=dip(4,jj,i)*dip(4,kk,k)
8255 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8256 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8257 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8258 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8259 call transpose2(EE(1,1,itk),auxmat(1,1))
8260 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8261 vv(1)=pizda(1,1)+pizda(2,2)
8262 vv(2)=pizda(2,1)-pizda(1,2)
8263 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8264 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8265 !d & "sum",-(s2+s3+s4)
8267 eello6_graph3=-(s1+s2+s3+s4)
8269 eello6_graph3=-(s2+s3+s4)
8272 ! Derivatives in gamma(k-1)
8273 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8274 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8275 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8276 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8277 ! Derivatives in gamma(l-1)
8278 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8279 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8280 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8281 vv(1)=pizda(1,1)+pizda(2,2)
8282 vv(2)=pizda(2,1)-pizda(1,2)
8283 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8284 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8285 ! Cartesian derivatives.
8291 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8293 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8296 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8298 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8299 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8301 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8302 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
8304 vv(1)=pizda(1,1)+pizda(2,2)
8305 vv(2)=pizda(2,1)-pizda(1,2)
8306 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8308 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8310 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8313 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8315 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8317 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8322 end function eello6_graph3
8323 !-----------------------------------------------------------------------------
8324 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8325 ! implicit real*8 (a-h,o-z)
8326 ! include 'DIMENSIONS'
8327 ! include 'COMMON.IOUNITS'
8328 ! include 'COMMON.CHAIN'
8329 ! include 'COMMON.DERIV'
8330 ! include 'COMMON.INTERACT'
8331 ! include 'COMMON.CONTACTS'
8332 ! include 'COMMON.TORSION'
8333 ! include 'COMMON.VAR'
8334 ! include 'COMMON.GEO'
8335 ! include 'COMMON.FFIELD'
8336 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
8337 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8339 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
8341 real(kind=8) :: s1,s2,s3,s4
8342 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8344 ! Parallel Antiparallel C
8350 ! \ j|/k\| \ |/k\|l C
8355 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8357 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
8358 ! energy moment and not to the cluster cumulant.
8359 !d write (2,*) 'eello_graph4: wturn6',wturn6
8360 iti=itortyp(itype(i))
8361 itj=itortyp(itype(j))
8362 if (j.lt.nres-1) then
8363 itj1=itortyp(itype(j+1))
8367 itk=itortyp(itype(k))
8368 if (k.lt.nres-1) then
8369 itk1=itortyp(itype(k+1))
8373 itl=itortyp(itype(l))
8374 if (l.lt.nres-1) then
8375 itl1=itortyp(itype(l+1))
8379 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8380 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8381 !d & ' itl',itl,' itl1',itl1
8384 s1=dip(3,jj,i)*dip(3,kk,k)
8386 s1=dip(2,jj,j)*dip(2,kk,l)
8389 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8390 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8392 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8393 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8395 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8396 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8398 call transpose2(EUg(1,1,k),auxmat(1,1))
8399 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8400 vv(1)=pizda(1,1)-pizda(2,2)
8401 vv(2)=pizda(2,1)+pizda(1,2)
8402 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8403 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8405 eello6_graph4=-(s1+s2+s3+s4)
8407 eello6_graph4=-(s2+s3+s4)
8409 ! Derivatives in gamma(i-1)
8413 s1=dipderg(2,jj,i)*dip(3,kk,k)
8415 s1=dipderg(4,jj,j)*dip(2,kk,l)
8418 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8420 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8421 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8423 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8424 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8426 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8427 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8428 !d write (2,*) 'turn6 derivatives'
8430 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8432 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8436 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8438 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8442 ! Derivatives in gamma(k-1)
8445 s1=dip(3,jj,i)*dipderg(2,kk,k)
8447 s1=dip(2,jj,j)*dipderg(4,kk,l)
8450 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8451 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8453 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8454 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8456 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8457 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8459 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8460 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8461 vv(1)=pizda(1,1)-pizda(2,2)
8462 vv(2)=pizda(2,1)+pizda(1,2)
8463 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8464 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8466 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8468 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8472 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8474 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8477 ! Derivatives in gamma(j-1) or gamma(l-1)
8478 if (l.eq.j+1 .and. l.gt.1) then
8479 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8480 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8481 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8482 vv(1)=pizda(1,1)-pizda(2,2)
8483 vv(2)=pizda(2,1)+pizda(1,2)
8484 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8485 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8486 else if (j.gt.1) then
8487 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8488 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8489 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8490 vv(1)=pizda(1,1)-pizda(2,2)
8491 vv(2)=pizda(2,1)+pizda(1,2)
8492 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8493 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8494 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8496 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8499 ! Cartesian derivatives.
8506 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8508 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8512 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8514 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8518 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
8520 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8522 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
8523 b1(1,itj1),auxvec(1))
8524 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8526 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
8527 b1(1,itl1),auxvec(1))
8528 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8530 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
8532 vv(1)=pizda(1,1)-pizda(2,2)
8533 vv(2)=pizda(2,1)+pizda(1,2)
8534 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8536 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8538 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
8541 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
8544 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8547 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8549 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8551 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8555 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8557 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8560 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8562 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8569 end function eello6_graph4
8570 !-----------------------------------------------------------------------------
8571 real(kind=8) function eello_turn6(i,jj,kk)
8572 ! implicit real*8 (a-h,o-z)
8573 ! include 'DIMENSIONS'
8574 ! include 'COMMON.IOUNITS'
8575 ! include 'COMMON.CHAIN'
8576 ! include 'COMMON.DERIV'
8577 ! include 'COMMON.INTERACT'
8578 ! include 'COMMON.CONTACTS'
8579 ! include 'COMMON.TORSION'
8580 ! include 'COMMON.VAR'
8581 ! include 'COMMON.GEO'
8582 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
8583 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
8584 real(kind=8),dimension(3) :: ggg1,ggg2
8585 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
8586 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
8587 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8588 ! the respective energy moment and not to the cluster cumulant.
8590 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
8591 integer :: j1,j2,l1,l2,ll
8592 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
8593 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
8602 iti=itortyp(itype(i))
8603 itk=itortyp(itype(k))
8604 itk1=itortyp(itype(k+1))
8605 itl=itortyp(itype(l))
8606 itj=itortyp(itype(j))
8607 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8608 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
8609 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8614 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8616 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
8620 derx_turn(lll,kkk,iii)=0.0d0
8627 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8629 !d write (2,*) 'eello6_5',eello6_5
8631 call transpose2(AEA(1,1,1),auxmat(1,1))
8632 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8633 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8634 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8636 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8637 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8638 s2 = scalar2(b1(1,itk),vtemp1(1))
8640 call transpose2(AEA(1,1,2),atemp(1,1))
8641 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8642 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8643 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8645 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8646 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8647 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8649 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8650 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8651 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8652 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8653 ss13 = scalar2(b1(1,itk),vtemp4(1))
8654 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8656 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8662 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8663 ! Derivatives in gamma(i+2)
8667 call transpose2(AEA(1,1,1),auxmatd(1,1))
8668 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8669 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8670 call transpose2(AEAderg(1,1,2),atempd(1,1))
8671 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8672 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8674 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8675 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8676 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8682 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8683 ! Derivatives in gamma(i+3)
8685 call transpose2(AEA(1,1,1),auxmatd(1,1))
8686 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8687 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8688 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8690 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8691 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8692 s2d = scalar2(b1(1,itk),vtemp1d(1))
8694 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8695 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8697 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8699 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8700 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8701 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8709 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
8710 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8712 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
8713 -0.5d0*ekont*(s2d+s12d)
8715 ! Derivatives in gamma(i+4)
8716 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8717 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8718 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8720 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8721 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8722 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8730 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8732 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8734 ! Derivatives in gamma(i+5)
8736 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8737 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8738 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8740 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8741 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8742 s2d = scalar2(b1(1,itk),vtemp1d(1))
8744 call transpose2(AEA(1,1,2),atempd(1,1))
8745 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8746 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8748 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8749 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8751 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8752 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8753 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8761 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
8762 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8764 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
8765 -0.5d0*ekont*(s2d+s12d)
8767 ! Cartesian derivatives
8772 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8773 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8774 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8776 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8777 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
8779 s2d = scalar2(b1(1,itk),vtemp1d(1))
8781 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8782 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8783 s8d = -(atempd(1,1)+atempd(2,2))* &
8784 scalar2(cc(1,1,itl),vtemp2(1))
8786 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
8788 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8789 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8796 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
8799 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
8803 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
8806 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
8815 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
8817 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8818 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8819 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8820 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8821 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
8823 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8824 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8825 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8829 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8830 !d & 16*eel_turn6_num
8832 if (j.lt.nres-1) then
8839 if (l.lt.nres-1) then
8847 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
8848 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
8849 !grad ghalf=0.5d0*ggg1(ll)
8851 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8852 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8853 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
8854 +ekont*derx_turn(ll,2,1)
8855 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8856 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
8857 +ekont*derx_turn(ll,4,1)
8858 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8859 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8860 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8861 !grad ghalf=0.5d0*ggg2(ll)
8863 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
8864 +ekont*derx_turn(ll,2,2)
8865 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8866 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
8867 +ekont*derx_turn(ll,4,2)
8868 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8869 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8870 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8875 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8880 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8886 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8891 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8895 !d write (2,*) iii,g_corr6_loc(iii)
8897 eello_turn6=ekont*eel_turn6
8898 !d write (2,*) 'ekont',ekont
8899 !d write (2,*) 'eel_turn6',ekont*eel_turn6
8901 end function eello_turn6
8902 !-----------------------------------------------------------------------------
8903 subroutine MATVEC2(A1,V1,V2)
8904 !DIR$ INLINEALWAYS MATVEC2
8906 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8908 ! implicit real*8 (a-h,o-z)
8909 ! include 'DIMENSIONS'
8910 real(kind=8),dimension(2) :: V1,V2
8911 real(kind=8),dimension(2,2) :: A1
8912 real(kind=8) :: vaux1,vaux2
8916 ! 3 VI=VI+A1(I,K)*V1(K)
8920 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8921 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8925 end subroutine MATVEC2
8926 !-----------------------------------------------------------------------------
8927 subroutine MATMAT2(A1,A2,A3)
8929 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8931 ! implicit real*8 (a-h,o-z)
8932 ! include 'DIMENSIONS'
8933 real(kind=8),dimension(2,2) :: A1,A2,A3
8934 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
8935 ! DIMENSION AI3(2,2)
8939 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
8945 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8946 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8947 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8948 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8954 end subroutine MATMAT2
8955 !-----------------------------------------------------------------------------
8956 real(kind=8) function scalar2(u,v)
8957 !DIR$ INLINEALWAYS scalar2
8959 real(kind=8),dimension(2) :: u,v
8962 scalar2=u(1)*v(1)+u(2)*v(2)
8964 end function scalar2
8965 !-----------------------------------------------------------------------------
8966 subroutine transpose2(a,at)
8967 !DIR$ INLINEALWAYS transpose2
8969 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
8972 real(kind=8),dimension(2,2) :: a,at
8978 end subroutine transpose2
8979 !-----------------------------------------------------------------------------
8980 subroutine transpose(n,a,at)
8983 real(kind=8),dimension(n,n) :: a,at
8990 end subroutine transpose
8991 !-----------------------------------------------------------------------------
8992 subroutine prodmat3(a1,a2,kk,transp,prod)
8993 !DIR$ INLINEALWAYS prodmat3
8995 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
8999 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
9001 !rc double precision auxmat(2,2),prod_(2,2)
9004 !rc call transpose2(kk(1,1),auxmat(1,1))
9005 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9006 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9008 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
9009 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9010 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
9011 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9012 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
9013 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9014 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
9015 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9018 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9019 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9021 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
9022 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9023 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
9024 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9025 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
9026 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9027 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
9028 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9031 ! call transpose2(a2(1,1),a2t(1,1))
9034 !rc print *,((prod_(i,j),i=1,2),j=1,2)
9035 !rc print *,((prod(i,j),i=1,2),j=1,2)
9038 end subroutine prodmat3
9039 !-----------------------------------------------------------------------------
9040 ! energy_p_new_barrier.F
9041 !-----------------------------------------------------------------------------
9042 subroutine sum_gradient
9043 ! implicit real*8 (a-h,o-z)
9044 use io_base, only: pdbout
9045 ! include 'DIMENSIONS'
9049 !MS$ATTRIBUTES C :: proc_proc
9055 real(kind=8),dimension(3,nres) :: gradbufc,gradbufx,gradbufc_sum,&
9056 gloc_scbuf !(3,maxres)
9058 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
9061 integer :: i,j,k,ierror,ierr
9062 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
9063 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
9064 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
9065 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
9066 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
9067 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
9068 gsccorr_max,gsccorrx_max,time00
9070 ! include 'COMMON.SETUP'
9071 ! include 'COMMON.IOUNITS'
9072 ! include 'COMMON.FFIELD'
9073 ! include 'COMMON.DERIV'
9074 ! include 'COMMON.INTERACT'
9075 ! include 'COMMON.SBRIDGE'
9076 ! include 'COMMON.CHAIN'
9077 ! include 'COMMON.VAR'
9078 ! include 'COMMON.CONTROL'
9079 ! include 'COMMON.TIME1'
9080 ! include 'COMMON.MAXGRAD'
9081 ! include 'COMMON.SCCOR'
9086 write (iout,*) "sum_gradient gvdwc, gvdwx"
9088 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9089 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
9099 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
9100 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
9101 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
9104 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
9105 ! in virtual-bond-vector coordinates
9108 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
9110 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
9111 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
9113 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
9115 ! write (iout,'(i5,3f10.5,2x,f10.5)')
9116 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
9118 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
9120 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9121 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
9122 (gvdwc_scpp(j,i),j=1,3)
9124 write (iout,*) "gelc_long gvdwpp gel_loc_long"
9126 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9127 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
9128 (gelc_loc_long(j,i),j=1,3)
9135 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
9136 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
9137 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
9138 wel_loc*gel_loc_long(j,i)+ &
9139 wcorr*gradcorr_long(j,i)+ &
9140 wcorr5*gradcorr5_long(j,i)+ &
9141 wcorr6*gradcorr6_long(j,i)+ &
9142 wturn6*gcorr6_turn_long(j,i)+ &
9149 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
9150 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
9151 welec*gelc_long(j,i)+ &
9153 wel_loc*gel_loc_long(j,i)+ &
9154 wcorr*gradcorr_long(j,i)+ &
9155 wcorr5*gradcorr5_long(j,i)+ &
9156 wcorr6*gradcorr6_long(j,i)+ &
9157 wturn6*gcorr6_turn_long(j,i)+ &
9163 if (nfgtasks.gt.1) then
9166 write (iout,*) "gradbufc before allreduce"
9168 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9174 gradbufc_sum(j,i)=gradbufc(j,i)
9177 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
9178 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
9179 ! time_reduce=time_reduce+MPI_Wtime()-time00
9181 ! write (iout,*) "gradbufc_sum after allreduce"
9183 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
9188 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
9196 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
9197 write (iout,*) (i," jgrad_start",jgrad_start(i),&
9198 " jgrad_end ",jgrad_end(i),&
9199 i=igrad_start,igrad_end)
9202 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
9203 ! do not parallelize this part.
9205 ! do i=igrad_start,igrad_end
9206 ! do j=jgrad_start(i),jgrad_end(i)
9208 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
9213 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
9217 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
9221 write (iout,*) "gradbufc after summing"
9223 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9231 write (iout,*) "gradbufc"
9233 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9240 gradbufc_sum(j,i)=gradbufc(j,i)
9245 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
9249 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
9254 ! gradbufc(k,i)=0.0d0
9258 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
9264 write (iout,*) "gradbufc after summing"
9266 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9275 gradbufc(k,nres)=0.0d0
9278 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
9279 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
9280 !el-----------------
9284 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
9285 wel_loc*gel_loc(j,i)+ &
9286 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
9287 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
9288 wel_loc*gel_loc_long(j,i)+ &
9289 wcorr*gradcorr_long(j,i)+ &
9290 wcorr5*gradcorr5_long(j,i)+ &
9291 wcorr6*gradcorr6_long(j,i)+ &
9292 wturn6*gcorr6_turn_long(j,i))+ &
9294 wcorr*gradcorr(j,i)+ &
9295 wturn3*gcorr3_turn(j,i)+ &
9296 wturn4*gcorr4_turn(j,i)+ &
9297 wcorr5*gradcorr5(j,i)+ &
9298 wcorr6*gradcorr6(j,i)+ &
9299 wturn6*gcorr6_turn(j,i)+ &
9300 wsccor*gsccorc(j,i) &
9303 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
9304 wel_loc*gel_loc(j,i)+ &
9305 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
9306 welec*gelc_long(j,i)+ &
9307 wel_loc*gel_loc_long(j,i)+ &
9308 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
9309 wcorr5*gradcorr5_long(j,i)+ &
9310 wcorr6*gradcorr6_long(j,i)+ &
9311 wturn6*gcorr6_turn_long(j,i))+ &
9313 wcorr*gradcorr(j,i)+ &
9314 wturn3*gcorr3_turn(j,i)+ &
9315 wturn4*gcorr4_turn(j,i)+ &
9316 wcorr5*gradcorr5(j,i)+ &
9317 wcorr6*gradcorr6(j,i)+ &
9318 wturn6*gcorr6_turn(j,i)+ &
9319 wsccor*gsccorc(j,i) &
9322 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
9323 wbond*gradbx(j,i)+ &
9324 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
9325 wsccor*gsccorx(j,i) &
9326 +wscloc*gsclocx(j,i)
9330 write (iout,*) "gloc before adding corr"
9332 write (iout,*) i,gloc(i,icg)
9336 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
9337 +wcorr5*g_corr5_loc(i) &
9338 +wcorr6*g_corr6_loc(i) &
9339 +wturn4*gel_loc_turn4(i) &
9340 +wturn3*gel_loc_turn3(i) &
9341 +wturn6*gel_loc_turn6(i) &
9342 +wel_loc*gel_loc_loc(i)
9345 write (iout,*) "gloc after adding corr"
9347 write (iout,*) i,gloc(i,icg)
9351 if (nfgtasks.gt.1) then
9354 gradbufc(j,i)=gradc(j,i,icg)
9355 gradbufx(j,i)=gradx(j,i,icg)
9359 glocbuf(i)=gloc(i,icg)
9363 write (iout,*) "gloc_sc before reduce"
9366 write (iout,*) i,j,gloc_sc(j,i,icg)
9373 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
9377 call MPI_Barrier(FG_COMM,IERR)
9378 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
9380 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,&
9381 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9382 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,&
9383 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9384 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
9385 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9386 time_reduce=time_reduce+MPI_Wtime()-time00
9387 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
9388 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9389 time_reduce=time_reduce+MPI_Wtime()-time00
9392 write (iout,*) "gloc_sc after reduce"
9395 write (iout,*) i,j,gloc_sc(j,i,icg)
9401 write (iout,*) "gloc after reduce"
9403 write (iout,*) i,gloc(i,icg)
9408 if (gnorm_check) then
9410 ! Compute the maximum elements of the gradient
9420 gcorr3_turn_max=0.0d0
9421 gcorr4_turn_max=0.0d0
9424 gcorr6_turn_max=0.0d0
9434 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
9435 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
9436 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
9437 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
9438 gvdwc_scp_max=gvdwc_scp_norm
9439 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
9440 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
9441 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
9442 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
9443 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
9444 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
9445 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
9446 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
9447 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
9448 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
9449 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
9450 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
9451 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
9453 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
9454 gcorr3_turn_max=gcorr3_turn_norm
9455 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
9457 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
9458 gcorr4_turn_max=gcorr4_turn_norm
9459 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
9460 if (gradcorr5_norm.gt.gradcorr5_max) &
9461 gradcorr5_max=gradcorr5_norm
9462 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
9463 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
9464 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
9466 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
9467 gcorr6_turn_max=gcorr6_turn_norm
9468 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
9469 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
9470 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
9471 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
9472 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
9473 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
9474 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
9475 if (gradx_scp_norm.gt.gradx_scp_max) &
9476 gradx_scp_max=gradx_scp_norm
9477 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
9478 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
9479 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
9480 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
9481 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
9482 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
9483 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
9484 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
9488 open(istat,file=statname,position="append")
9490 open(istat,file=statname,access="append")
9492 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
9493 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
9494 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
9495 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
9496 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
9497 gsccorx_max,gsclocx_max
9499 if (gvdwc_max.gt.1.0d4) then
9500 write (iout,*) "gvdwc gvdwx gradb gradbx"
9502 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
9503 gradb(j,i),gradbx(j,i),j=1,3)
9505 call pdbout(0.0d0,'cipiszcze',iout)
9512 write (iout,*) "gradc gradx gloc"
9514 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
9515 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
9520 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
9523 end subroutine sum_gradient
9524 !-----------------------------------------------------------------------------
9526 ! implicit real*8 (a-h,o-z)
9528 ! include 'DIMENSIONS'
9529 ! include 'COMMON.CHAIN'
9530 ! include 'COMMON.DERIV'
9531 ! include 'COMMON.CALC'
9532 ! include 'COMMON.IOUNITS'
9533 real(kind=8), dimension(3) :: dcosom1,dcosom2
9535 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
9536 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
9537 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
9538 -2.0D0*alf12*eps3der+sigder*sigsq_om12
9542 ! eom12=evdwij*eps1_om12
9544 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
9546 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
9547 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
9549 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
9550 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
9553 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
9555 ! write (iout,*) "gg",(gg(k),k=1,3)
9557 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
9558 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
9559 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
9560 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
9561 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
9562 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
9563 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
9564 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
9565 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
9566 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
9569 ! Calculate the components of the gradient in DC and X
9573 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
9577 gvdwc(l,i)=gvdwc(l,i)-gg(l)
9578 gvdwc(l,j)=gvdwc(l,j)+gg(l)
9581 end subroutine sc_grad
9583 !-----------------------------------------------------------------------------
9584 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
9587 ! implicit real*8 (a-h,o-z)
9588 ! include 'DIMENSIONS'
9589 ! include 'COMMON.LOCAL'
9590 ! include 'COMMON.IOUNITS'
9591 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
9592 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
9593 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
9594 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
9595 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
9597 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
9598 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
9599 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
9602 delthec=thetai-thet_pred_mean
9603 delthe0=thetai-theta0i
9604 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
9605 t3 = thetai-thet_pred_mean
9609 t14 = t12+t6*sigsqtc
9611 t21 = thetai-theta0i
9617 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
9618 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
9619 *(-t12*t9-ak*sig0inv*t27)
9621 end subroutine mixder
9623 !-----------------------------------------------------------------------------
9625 !-----------------------------------------------------------------------------
9627 !-----------------------------------------------------------------------------
9628 ! This subroutine calculates the derivatives of the consecutive virtual
9629 ! bond vectors and the SC vectors in the virtual-bond angles theta and
9630 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
9631 ! in the angles alpha and omega, describing the location of a side chain
9632 ! in its local coordinate system.
9634 ! The derivatives are stored in the following arrays:
9636 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
9637 ! The structure is as follows:
9639 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
9640 ! 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)
9641 ! . . . . . . . . . . . . . . . . . .
9642 ! 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)
9646 ! 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)
9648 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
9649 ! The structure is same as above.
9651 ! DCDS - the derivatives of the side chain vectors in the local spherical
9652 ! andgles alph and omega:
9654 ! 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)
9655 ! 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)
9659 ! 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)
9661 ! Version of March '95, based on an early version of November '91.
9663 !**********************************************************************
9664 ! implicit real*8 (a-h,o-z)
9665 ! include 'DIMENSIONS'
9666 ! include 'COMMON.VAR'
9667 ! include 'COMMON.CHAIN'
9668 ! include 'COMMON.DERIV'
9669 ! include 'COMMON.GEO'
9670 ! include 'COMMON.LOCAL'
9671 ! include 'COMMON.INTERACT'
9672 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
9673 real(kind=8),dimension(3,3) :: dp,temp
9674 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
9675 real(kind=8),dimension(3) :: xx,xx1
9677 integer :: i,k,l,j,m,ind,ind1,jjj
9678 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
9679 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
9680 sint2,xp,yp,xxp,yyp,zzp,dj
9682 ! common /przechowalnia/ fromto
9683 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
9684 ! get the position of the jth ijth fragment of the chain coordinate system
9685 ! in the fromto array.
9686 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
9688 ! maxdim=(nres-1)*(nres-2)/2
9689 ! allocate(dcdv(6,maxdim),dxds(6,nres))
9690 ! calculate the derivatives of transformation matrix elements in theta
9693 !el call flush(iout) !el
9695 rdt(1,1,i)=-rt(1,2,i)
9696 rdt(1,2,i)= rt(1,1,i)
9698 rdt(2,1,i)=-rt(2,2,i)
9699 rdt(2,2,i)= rt(2,1,i)
9701 rdt(3,1,i)=-rt(3,2,i)
9702 rdt(3,2,i)= rt(3,1,i)
9706 ! derivatives in phi
9712 drt(2,1,i)= rt(3,1,i)
9713 drt(2,2,i)= rt(3,2,i)
9714 drt(2,3,i)= rt(3,3,i)
9715 drt(3,1,i)=-rt(2,1,i)
9716 drt(3,2,i)=-rt(2,2,i)
9717 drt(3,3,i)=-rt(2,3,i)
9720 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
9731 fromto(k,l,ind)=temp(k,l)
9740 dpkl=dpkl+temp(k,m)*rt(m,l,j)
9743 fromto(k,l,ind)=dpkl
9754 ! Calculate derivatives.
9760 ! Derivatives of DC(i+1) in theta(i+2)
9766 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
9769 prordt(j,k,i)=dp(j,k)
9772 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
9775 ! Derivatives of SC(i+1) in theta(i+2)
9777 xx1(1)=-0.5D0*xloc(2,i+1)
9778 xx1(2)= 0.5D0*xloc(1,i+1)
9782 xj=xj+r(j,k,i)*xx1(k)
9789 rj=rj+prod(j,k,i)*xx(k)
9794 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
9795 ! than the other off-diagonal derivatives.
9800 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
9802 dxdv(j,ind1+1)=dxoiij
9804 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
9806 ! Derivatives of DC(i+1) in phi(i+2)
9812 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
9815 prodrt(j,k,i)=dp(j,k)
9817 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
9820 ! Derivatives of SC(i+1) in phi(i+2)
9823 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
9824 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
9828 rj=rj+prod(j,k,i)*xx(k)
9833 ! Derivatives of SC(i+1) in phi(i+3).
9838 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
9840 dxdv(j+3,ind1+1)=dxoiij
9843 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
9844 ! theta(nres) and phi(i+3) thru phi(nres).
9849 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
9854 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
9859 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
9860 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
9861 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
9862 ! Derivatives of virtual-bond vectors in theta
9864 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
9866 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
9867 ! Derivatives of SC vectors in theta
9871 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
9873 dxdv(k,ind1+1)=dxoijk
9876 !--- Calculate the derivatives in phi
9882 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
9888 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
9893 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
9895 dxdv(k+3,ind1+1)=dxoijk
9900 ! Derivatives in alpha and omega:
9903 ! dsci=dsc(itype(i))
9908 if(alphi.ne.alphi) alphi=100.0
9909 if(omegi.ne.omegi) omegi=-100.0
9914 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
9915 cosalphi=dcos(alphi)
9916 sinalphi=dsin(alphi)
9917 cosomegi=dcos(omegi)
9918 sinomegi=dsin(omegi)
9919 temp(1,1)=-dsci*sinalphi
9920 temp(2,1)= dsci*cosalphi*cosomegi
9921 temp(3,1)=-dsci*cosalphi*sinomegi
9923 temp(2,2)=-dsci*sinalphi*sinomegi
9924 temp(3,2)=-dsci*sinalphi*cosomegi
9925 theta2=pi-0.5D0*theta(i+1)
9929 !d print *,((temp(l,k),l=1,3),k=1,2)
9933 xxp= xp*cost2+yp*sint2
9934 yyp=-xp*sint2+yp*cost2
9937 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
9938 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
9942 dj=dj+prod(k,l,i-1)*xx(l)
9950 end subroutine cartder
9951 !-----------------------------------------------------------------------------
9953 !-----------------------------------------------------------------------------
9954 subroutine check_cartgrad
9955 ! Check the gradient of Cartesian coordinates in internal coordinates.
9956 ! implicit real*8 (a-h,o-z)
9957 ! include 'DIMENSIONS'
9958 ! include 'COMMON.IOUNITS'
9959 ! include 'COMMON.VAR'
9960 ! include 'COMMON.CHAIN'
9961 ! include 'COMMON.GEO'
9962 ! include 'COMMON.LOCAL'
9963 ! include 'COMMON.DERIV'
9964 real(kind=8),dimension(6,nres) :: temp
9965 real(kind=8),dimension(3) :: xx,gg
9967 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
9968 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
9970 ! Check the gradient of the virtual-bond and SC vectors in the internal
9976 write (iout,'(a)') '**************** dx/dalpha'
9980 alph(i)=alph(i)+aincr
9982 temp(k,i)=dc(k,nres+i)
9986 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
9987 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
9989 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
9990 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
9996 write (iout,'(a)') '**************** dx/domega'
10000 omeg(i)=omeg(i)+aincr
10002 temp(k,i)=dc(k,nres+i)
10006 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
10007 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
10008 (aincr*dabs(dxds(k+3,i))+aincr))
10010 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
10011 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
10017 write (iout,'(a)') '**************** dx/dtheta'
10021 theta(i)=theta(i)+aincr
10024 temp(k,j)=dc(k,nres+j)
10030 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
10032 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
10033 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
10034 (aincr*dabs(dxdv(k,ii))+aincr))
10036 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10037 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
10044 write (iout,'(a)') '***************** dx/dphi'
10047 phi(i)=phi(i)+aincr
10050 temp(k,j)=dc(k,nres+j)
10058 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
10059 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
10060 (aincr*dabs(dxdv(k+3,ii))+aincr))
10062 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10063 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
10066 phi(i)=phi(i)-aincr
10069 write (iout,'(a)') '****************** ddc/dtheta'
10072 theta(i+2)=thet+aincr
10083 gg(k)=(dc(k,j)-temp(k,j))/aincr
10084 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
10085 (aincr*dabs(dcdv(k,ii))+aincr))
10087 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10088 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
10098 write (iout,'(a)') '******************* ddc/dphi'
10101 phi(i+3)=phii+aincr
10112 gg(k)=(dc(k,j)-temp(k,j))/aincr
10113 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
10114 (aincr*dabs(dcdv(k+3,ii))+aincr))
10116 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10117 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
10128 end subroutine check_cartgrad
10129 !-----------------------------------------------------------------------------
10130 subroutine check_ecart
10131 ! Check the gradient of the energy in Cartesian coordinates.
10132 ! implicit real*8 (a-h,o-z)
10133 ! include 'DIMENSIONS'
10134 ! include 'COMMON.CHAIN'
10135 ! include 'COMMON.DERIV'
10136 ! include 'COMMON.IOUNITS'
10137 ! include 'COMMON.VAR'
10138 ! include 'COMMON.CONTACTS'
10140 !el integer :: icall
10141 !el common /srutu/ icall
10142 real(kind=8),dimension(6) :: ggg
10143 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
10144 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10145 real(kind=8),dimension(6,nres) :: grad_s
10146 real(kind=8),dimension(0:n_ene) :: energia,energia1
10147 integer :: uiparm(1)
10148 real(kind=8) :: urparm(1)
10150 integer :: nf,i,j,k
10151 real(kind=8) :: aincr,etot,etot1
10157 print '(a)','CG processor',me,' calling CHECK_CART.'
10160 call geom_to_var(nvar,x)
10161 call etotal(energia)
10163 !el call enerprint(energia)
10164 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
10167 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10171 grad_s(j,i)=gradc(j,i,icg)
10172 grad_s(j+3,i)=gradx(j,i,icg)
10176 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10181 ddx(j)=dc(j,i+nres)
10184 dc(j,i)=dc(j,i)+aincr
10186 c(j,k)=c(j,k)+aincr
10187 c(j,k+nres)=c(j,k+nres)+aincr
10189 call etotal(energia1)
10191 ggg(j)=(etot1-etot)/aincr
10194 c(j,k)=c(j,k)-aincr
10195 c(j,k+nres)=c(j,k+nres)-aincr
10199 c(j,i+nres)=c(j,i+nres)+aincr
10200 dc(j,i+nres)=dc(j,i+nres)+aincr
10201 call etotal(energia1)
10203 ggg(j+3)=(etot1-etot)/aincr
10205 dc(j,i+nres)=ddx(j)
10207 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
10208 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
10211 end subroutine check_ecart
10212 !-----------------------------------------------------------------------------
10213 subroutine check_ecartint
10214 ! Check the gradient of the energy in Cartesian coordinates.
10215 use io_base, only: intout
10216 ! implicit real*8 (a-h,o-z)
10217 ! include 'DIMENSIONS'
10218 ! include 'COMMON.CONTROL'
10219 ! include 'COMMON.CHAIN'
10220 ! include 'COMMON.DERIV'
10221 ! include 'COMMON.IOUNITS'
10222 ! include 'COMMON.VAR'
10223 ! include 'COMMON.CONTACTS'
10224 ! include 'COMMON.MD'
10225 ! include 'COMMON.LOCAL'
10226 ! include 'COMMON.SPLITELE'
10228 !el integer :: icall
10229 !el common /srutu/ icall
10230 real(kind=8),dimension(6) :: ggg,ggg1
10231 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
10232 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10233 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
10234 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
10235 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
10236 real(kind=8),dimension(0:n_ene) :: energia,energia1
10237 integer :: uiparm(1)
10238 real(kind=8) :: urparm(1)
10240 integer :: i,j,k,nf
10241 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
10249 ! call intcartderiv
10250 ! call checkintcartgrad
10253 write(iout,*) 'Calling CHECK_ECARTINT.'
10256 call geom_to_var(nvar,x)
10257 if (.not.split_ene) then
10258 call etotal(energia)
10260 !el call enerprint(energia)
10262 write (iout,*) "enter cartgrad"
10265 write (iout,*) "exit cartgrad"
10269 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10272 grad_s(j,0)=gcart(j,0)
10276 grad_s(j,i)=gcart(j,i)
10277 grad_s(j+3,i)=gxcart(j,i)
10281 !- split gradient check
10283 call etotal_long(energia)
10284 !el call enerprint(energia)
10286 write (iout,*) "enter cartgrad"
10289 write (iout,*) "exit cartgrad"
10292 write (iout,*) "longrange grad"
10294 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10295 (gxcart(j,i),j=1,3)
10298 grad_s(j,0)=gcart(j,0)
10302 grad_s(j,i)=gcart(j,i)
10303 grad_s(j+3,i)=gxcart(j,i)
10307 call etotal_short(energia)
10308 !el call enerprint(energia)
10310 write (iout,*) "enter cartgrad"
10313 write (iout,*) "exit cartgrad"
10316 write (iout,*) "shortrange grad"
10318 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10319 (gxcart(j,i),j=1,3)
10322 grad_s1(j,0)=gcart(j,0)
10326 grad_s1(j,i)=gcart(j,i)
10327 grad_s1(j+3,i)=gxcart(j,i)
10331 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10336 ddx(j)=dc(j,i+nres)
10338 dcnorm_safe(k)=dc_norm(k,i)
10339 dxnorm_safe(k)=dc_norm(k,i+nres)
10343 dc(j,i)=ddc(j)+aincr
10344 call chainbuild_cart
10346 ! Broadcast the order to compute internal coordinates to the slaves.
10347 ! if (nfgtasks.gt.1)
10348 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
10350 ! call int_from_cart1(.false.)
10351 if (.not.split_ene) then
10352 call etotal(energia1)
10356 call etotal_long(energia1)
10358 call etotal_short(energia1)
10360 ! write (iout,*) "etot11",etot11," etot12",etot12
10362 !- end split gradient
10363 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10364 dc(j,i)=ddc(j)-aincr
10365 call chainbuild_cart
10366 ! call int_from_cart1(.false.)
10367 if (.not.split_ene) then
10368 call etotal(energia1)
10370 ggg(j)=(etot1-etot2)/(2*aincr)
10373 call etotal_long(energia1)
10375 ggg(j)=(etot11-etot21)/(2*aincr)
10376 call etotal_short(energia1)
10378 ggg1(j)=(etot12-etot22)/(2*aincr)
10379 !- end split gradient
10380 ! write (iout,*) "etot21",etot21," etot22",etot22
10382 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10384 call chainbuild_cart
10387 dc(j,i+nres)=ddx(j)+aincr
10388 call chainbuild_cart
10389 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
10390 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
10391 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
10392 ! write (iout,*) "dxnormnorm",dsqrt(
10393 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
10394 ! write (iout,*) "dxnormnormsafe",dsqrt(
10395 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
10397 if (.not.split_ene) then
10398 call etotal(energia1)
10402 call etotal_long(energia1)
10404 call etotal_short(energia1)
10407 !- end split gradient
10408 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10409 dc(j,i+nres)=ddx(j)-aincr
10410 call chainbuild_cart
10411 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
10412 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
10413 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
10415 ! write (iout,*) "dxnormnorm",dsqrt(
10416 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
10417 ! write (iout,*) "dxnormnormsafe",dsqrt(
10418 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
10419 if (.not.split_ene) then
10420 call etotal(energia1)
10422 ggg(j+3)=(etot1-etot2)/(2*aincr)
10425 call etotal_long(energia1)
10427 ggg(j+3)=(etot11-etot21)/(2*aincr)
10428 call etotal_short(energia1)
10430 ggg1(j+3)=(etot12-etot22)/(2*aincr)
10431 !- end split gradient
10433 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10434 dc(j,i+nres)=ddx(j)
10435 call chainbuild_cart
10437 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10438 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
10439 if (split_ene) then
10440 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10441 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
10443 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10444 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
10445 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
10449 end subroutine check_ecartint
10450 !-----------------------------------------------------------------------------
10451 subroutine check_eint
10452 ! Check the gradient of energy in internal coordinates.
10453 ! implicit real*8 (a-h,o-z)
10454 ! include 'DIMENSIONS'
10455 ! include 'COMMON.CHAIN'
10456 ! include 'COMMON.DERIV'
10457 ! include 'COMMON.IOUNITS'
10458 ! include 'COMMON.VAR'
10459 ! include 'COMMON.GEO'
10461 !el integer :: icall
10462 !el common /srutu/ icall
10463 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
10464 integer :: uiparm(1)
10465 real(kind=8) :: urparm(1)
10466 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
10467 character(len=6) :: key
10470 real(kind=8) :: xi,aincr,etot,etot1,etot2
10473 print '(a)','Calling CHECK_INT.'
10477 call geom_to_var(nvar,x)
10478 call var_to_geom(nvar,x)
10482 call etotal(energia)
10484 !el call enerprint(energia)
10487 if (MyID.ne.BossID) then
10488 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
10496 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
10497 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
10498 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
10502 x(i)=xi-0.5D0*aincr
10503 call var_to_geom(nvar,x)
10505 call etotal(energia1)
10507 x(i)=xi+0.5D0*aincr
10508 call var_to_geom(nvar,x)
10510 call etotal(energia2)
10512 gg(i)=(etot2-etot1)/aincr
10513 write (iout,*) i,etot1,etot2
10516 write (iout,'(/2a)')' Variable Numerical Analytical',&
10519 if (i.le.nphi) then
10522 else if (i.le.nphi+ntheta) then
10525 else if (i.le.nphi+ntheta+nside) then
10529 ii=i-(nphi+ntheta+nside)
10532 write (iout,'(i3,a,i3,3(1pd16.6))') &
10533 i,key,ii,gg(i),gana(i),&
10534 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
10537 end subroutine check_eint
10538 !-----------------------------------------------------------------------------
10540 !-----------------------------------------------------------------------------
10541 subroutine Econstr_back
10542 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
10543 ! implicit real*8 (a-h,o-z)
10544 ! include 'DIMENSIONS'
10545 ! include 'COMMON.CONTROL'
10546 ! include 'COMMON.VAR'
10547 ! include 'COMMON.MD'
10550 ! include 'COMMON.LANGEVIN'
10552 ! include 'COMMON.LANGEVIN.lang0'
10554 ! include 'COMMON.CHAIN'
10555 ! include 'COMMON.DERIV'
10556 ! include 'COMMON.GEO'
10557 ! include 'COMMON.LOCAL'
10558 ! include 'COMMON.INTERACT'
10559 ! include 'COMMON.IOUNITS'
10560 ! include 'COMMON.NAMES'
10561 ! include 'COMMON.TIME1'
10562 integer :: i,j,ii,k
10563 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
10565 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
10566 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
10567 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
10574 duscdiff(j,i)=0.0d0
10575 duscdiffx(j,i)=0.0d0
10579 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
10581 ! Deviations from theta angles
10584 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
10585 dtheta_i=theta(j)-thetaref(j)
10586 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
10587 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
10589 utheta(i)=utheta_i/(ii-1)
10591 ! Deviations from gamma angles
10594 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
10595 dgamma_i=pinorm(phi(j)-phiref(j))
10596 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
10597 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
10598 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
10599 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
10601 ugamma(i)=ugamma_i/(ii-2)
10603 ! Deviations from local SC geometry
10606 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
10607 dxx=xxtab(j)-xxref(j)
10608 dyy=yytab(j)-yyref(j)
10609 dzz=zztab(j)-zzref(j)
10610 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
10612 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
10613 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
10615 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
10616 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
10618 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
10619 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
10622 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
10623 ! & xxref(j),yyref(j),zzref(j)
10625 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
10626 ! write (iout,*) i," uscdiff",uscdiff(i)
10628 ! Put together deviations from local geometry
10630 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
10631 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
10632 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
10633 ! & " uconst_back",uconst_back
10634 utheta(i)=dsqrt(utheta(i))
10635 ugamma(i)=dsqrt(ugamma(i))
10636 uscdiff(i)=dsqrt(uscdiff(i))
10639 end subroutine Econstr_back
10640 !-----------------------------------------------------------------------------
10641 ! energy_p_new-sep_barrier.F
10642 !-----------------------------------------------------------------------------
10643 real(kind=8) function sscale(r)
10644 ! include "COMMON.SPLITELE"
10645 real(kind=8) :: r,gamm
10646 if(r.lt.r_cut-rlamb) then
10648 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10649 gamm=(r-(r_cut-rlamb))/rlamb
10650 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
10655 end function sscale
10656 !-----------------------------------------------------------------------------
10657 subroutine elj_long(evdw)
10659 ! This subroutine calculates the interaction energy of nonbonded side chains
10660 ! assuming the LJ potential of interaction.
10662 ! implicit real*8 (a-h,o-z)
10663 ! include 'DIMENSIONS'
10664 ! include 'COMMON.GEO'
10665 ! include 'COMMON.VAR'
10666 ! include 'COMMON.LOCAL'
10667 ! include 'COMMON.CHAIN'
10668 ! include 'COMMON.DERIV'
10669 ! include 'COMMON.INTERACT'
10670 ! include 'COMMON.TORSION'
10671 ! include 'COMMON.SBRIDGE'
10672 ! include 'COMMON.NAMES'
10673 ! include 'COMMON.IOUNITS'
10674 ! include 'COMMON.CONTACTS'
10675 real(kind=8),parameter :: accur=1.0d-10
10676 real(kind=8),dimension(3) :: gg
10677 !el local variables
10678 integer :: i,iint,j,k,itypi,itypi1,itypj
10679 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
10680 real(kind=8) :: e1,e2,evdwij,evdw
10681 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
10683 do i=iatsc_s,iatsc_e
10685 if (itypi.eq.ntyp1) cycle
10691 ! Calculate SC interaction energy.
10693 do iint=1,nint_gr(i)
10694 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
10695 !d & 'iend=',iend(i,iint)
10696 do j=istart(i,iint),iend(i,iint)
10698 if (itypj.eq.ntyp1) cycle
10702 rij=xj*xj+yj*yj+zj*zj
10703 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
10704 if (sss.lt.1.0d0) then
10706 eps0ij=eps(itypi,itypj)
10708 e1=fac*fac*aa(itypi,itypj)
10709 e2=fac*bb(itypi,itypj)
10711 evdw=evdw+(1.0d0-sss)*evdwij
10713 ! Calculate the components of the gradient in DC and X
10715 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
10720 gvdwx(k,i)=gvdwx(k,i)-gg(k)
10721 gvdwx(k,j)=gvdwx(k,j)+gg(k)
10722 gvdwc(k,i)=gvdwc(k,i)-gg(k)
10723 gvdwc(k,j)=gvdwc(k,j)+gg(k)
10731 gvdwc(j,i)=expon*gvdwc(j,i)
10732 gvdwx(j,i)=expon*gvdwx(j,i)
10735 !******************************************************************************
10739 ! To save time, the factor of EXPON has been extracted from ALL components
10740 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
10743 !******************************************************************************
10745 end subroutine elj_long
10746 !-----------------------------------------------------------------------------
10747 subroutine elj_short(evdw)
10749 ! This subroutine calculates the interaction energy of nonbonded side chains
10750 ! assuming the LJ potential of interaction.
10752 ! implicit real*8 (a-h,o-z)
10753 ! include 'DIMENSIONS'
10754 ! include 'COMMON.GEO'
10755 ! include 'COMMON.VAR'
10756 ! include 'COMMON.LOCAL'
10757 ! include 'COMMON.CHAIN'
10758 ! include 'COMMON.DERIV'
10759 ! include 'COMMON.INTERACT'
10760 ! include 'COMMON.TORSION'
10761 ! include 'COMMON.SBRIDGE'
10762 ! include 'COMMON.NAMES'
10763 ! include 'COMMON.IOUNITS'
10764 ! include 'COMMON.CONTACTS'
10765 real(kind=8),parameter :: accur=1.0d-10
10766 real(kind=8),dimension(3) :: gg
10767 !el local variables
10768 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
10769 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
10770 real(kind=8) :: e1,e2,evdwij,evdw
10771 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
10773 do i=iatsc_s,iatsc_e
10775 if (itypi.eq.ntyp1) cycle
10783 ! Calculate SC interaction energy.
10785 do iint=1,nint_gr(i)
10786 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
10787 !d & 'iend=',iend(i,iint)
10788 do j=istart(i,iint),iend(i,iint)
10790 if (itypj.eq.ntyp1) cycle
10794 ! Change 12/1/95 to calculate four-body interactions
10795 rij=xj*xj+yj*yj+zj*zj
10796 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
10797 if (sss.gt.0.0d0) then
10799 eps0ij=eps(itypi,itypj)
10801 e1=fac*fac*aa(itypi,itypj)
10802 e2=fac*bb(itypi,itypj)
10804 evdw=evdw+sss*evdwij
10806 ! Calculate the components of the gradient in DC and X
10808 fac=-rrij*(e1+evdwij)*sss
10813 gvdwx(k,i)=gvdwx(k,i)-gg(k)
10814 gvdwx(k,j)=gvdwx(k,j)+gg(k)
10815 gvdwc(k,i)=gvdwc(k,i)-gg(k)
10816 gvdwc(k,j)=gvdwc(k,j)+gg(k)
10824 gvdwc(j,i)=expon*gvdwc(j,i)
10825 gvdwx(j,i)=expon*gvdwx(j,i)
10828 !******************************************************************************
10832 ! To save time, the factor of EXPON has been extracted from ALL components
10833 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
10836 !******************************************************************************
10838 end subroutine elj_short
10839 !-----------------------------------------------------------------------------
10840 subroutine eljk_long(evdw)
10842 ! This subroutine calculates the interaction energy of nonbonded side chains
10843 ! assuming the LJK potential of interaction.
10845 ! implicit real*8 (a-h,o-z)
10846 ! include 'DIMENSIONS'
10847 ! include 'COMMON.GEO'
10848 ! include 'COMMON.VAR'
10849 ! include 'COMMON.LOCAL'
10850 ! include 'COMMON.CHAIN'
10851 ! include 'COMMON.DERIV'
10852 ! include 'COMMON.INTERACT'
10853 ! include 'COMMON.IOUNITS'
10854 ! include 'COMMON.NAMES'
10855 real(kind=8),dimension(3) :: gg
10857 !el local variables
10858 integer :: i,iint,j,k,itypi,itypi1,itypj
10859 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
10860 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
10861 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
10863 do i=iatsc_s,iatsc_e
10865 if (itypi.eq.ntyp1) cycle
10871 ! Calculate SC interaction energy.
10873 do iint=1,nint_gr(i)
10874 do j=istart(i,iint),iend(i,iint)
10876 if (itypj.eq.ntyp1) cycle
10880 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
10881 fac_augm=rrij**expon
10882 e_augm=augm(itypi,itypj)*fac_augm
10883 r_inv_ij=dsqrt(rrij)
10885 sss=sscale(rij/sigma(itypi,itypj))
10886 if (sss.lt.1.0d0) then
10887 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
10888 fac=r_shift_inv**expon
10889 e1=fac*fac*aa(itypi,itypj)
10890 e2=fac*bb(itypi,itypj)
10891 evdwij=e_augm+e1+e2
10892 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
10893 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
10894 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
10895 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
10896 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
10897 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
10898 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
10899 evdw=evdw+(1.0d0-sss)*evdwij
10901 ! Calculate the components of the gradient in DC and X
10903 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
10904 fac=fac*(1.0d0-sss)
10909 gvdwx(k,i)=gvdwx(k,i)-gg(k)
10910 gvdwx(k,j)=gvdwx(k,j)+gg(k)
10911 gvdwc(k,i)=gvdwc(k,i)-gg(k)
10912 gvdwc(k,j)=gvdwc(k,j)+gg(k)
10920 gvdwc(j,i)=expon*gvdwc(j,i)
10921 gvdwx(j,i)=expon*gvdwx(j,i)
10925 end subroutine eljk_long
10926 !-----------------------------------------------------------------------------
10927 subroutine eljk_short(evdw)
10929 ! This subroutine calculates the interaction energy of nonbonded side chains
10930 ! assuming the LJK potential of interaction.
10932 ! implicit real*8 (a-h,o-z)
10933 ! include 'DIMENSIONS'
10934 ! include 'COMMON.GEO'
10935 ! include 'COMMON.VAR'
10936 ! include 'COMMON.LOCAL'
10937 ! include 'COMMON.CHAIN'
10938 ! include 'COMMON.DERIV'
10939 ! include 'COMMON.INTERACT'
10940 ! include 'COMMON.IOUNITS'
10941 ! include 'COMMON.NAMES'
10942 real(kind=8),dimension(3) :: gg
10944 !el local variables
10945 integer :: i,iint,j,k,itypi,itypi1,itypj
10946 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
10947 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
10948 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
10950 do i=iatsc_s,iatsc_e
10952 if (itypi.eq.ntyp1) cycle
10958 ! Calculate SC interaction energy.
10960 do iint=1,nint_gr(i)
10961 do j=istart(i,iint),iend(i,iint)
10963 if (itypj.eq.ntyp1) cycle
10967 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
10968 fac_augm=rrij**expon
10969 e_augm=augm(itypi,itypj)*fac_augm
10970 r_inv_ij=dsqrt(rrij)
10972 sss=sscale(rij/sigma(itypi,itypj))
10973 if (sss.gt.0.0d0) then
10974 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
10975 fac=r_shift_inv**expon
10976 e1=fac*fac*aa(itypi,itypj)
10977 e2=fac*bb(itypi,itypj)
10978 evdwij=e_augm+e1+e2
10979 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
10980 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
10981 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
10982 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
10983 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
10984 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
10985 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
10986 evdw=evdw+sss*evdwij
10988 ! Calculate the components of the gradient in DC and X
10990 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
10996 gvdwx(k,i)=gvdwx(k,i)-gg(k)
10997 gvdwx(k,j)=gvdwx(k,j)+gg(k)
10998 gvdwc(k,i)=gvdwc(k,i)-gg(k)
10999 gvdwc(k,j)=gvdwc(k,j)+gg(k)
11007 gvdwc(j,i)=expon*gvdwc(j,i)
11008 gvdwx(j,i)=expon*gvdwx(j,i)
11012 end subroutine eljk_short
11013 !-----------------------------------------------------------------------------
11014 subroutine ebp_long(evdw)
11016 ! This subroutine calculates the interaction energy of nonbonded side chains
11017 ! assuming the Berne-Pechukas potential of interaction.
11020 ! implicit real*8 (a-h,o-z)
11021 ! include 'DIMENSIONS'
11022 ! include 'COMMON.GEO'
11023 ! include 'COMMON.VAR'
11024 ! include 'COMMON.LOCAL'
11025 ! include 'COMMON.CHAIN'
11026 ! include 'COMMON.DERIV'
11027 ! include 'COMMON.NAMES'
11028 ! include 'COMMON.INTERACT'
11029 ! include 'COMMON.IOUNITS'
11030 ! include 'COMMON.CALC'
11032 !el integer :: icall
11033 !el common /srutu/ icall
11034 ! double precision rrsave(maxdim)
11036 !el local variables
11037 integer :: iint,itypi,itypi1,itypj
11038 real(kind=8) :: rrij,xi,yi,zi,fac
11039 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
11041 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
11043 ! if (icall.eq.0) then
11049 do i=iatsc_s,iatsc_e
11051 if (itypi.eq.ntyp1) cycle
11056 dxi=dc_norm(1,nres+i)
11057 dyi=dc_norm(2,nres+i)
11058 dzi=dc_norm(3,nres+i)
11059 ! dsci_inv=dsc_inv(itypi)
11060 dsci_inv=vbld_inv(i+nres)
11062 ! Calculate SC interaction energy.
11064 do iint=1,nint_gr(i)
11065 do j=istart(i,iint),iend(i,iint)
11068 if (itypj.eq.ntyp1) cycle
11069 ! dscj_inv=dsc_inv(itypj)
11070 dscj_inv=vbld_inv(j+nres)
11071 chi1=chi(itypi,itypj)
11072 chi2=chi(itypj,itypi)
11079 alf12=0.5D0*(alf1+alf2)
11083 dxj=dc_norm(1,nres+j)
11084 dyj=dc_norm(2,nres+j)
11085 dzj=dc_norm(3,nres+j)
11086 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11088 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11090 if (sss.lt.1.0d0) then
11092 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
11094 ! Calculate whole angle-dependent part of epsilon and contributions
11095 ! to its derivatives
11096 fac=(rrij*sigsq)**expon2
11097 e1=fac*fac*aa(itypi,itypj)
11098 e2=fac*bb(itypi,itypj)
11099 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11100 eps2der=evdwij*eps3rt
11101 eps3der=evdwij*eps2rt
11102 evdwij=evdwij*eps2rt*eps3rt
11103 evdw=evdw+evdwij*(1.0d0-sss)
11105 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11106 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11107 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
11108 !d & restyp(itypi),i,restyp(itypj),j,
11109 !d & epsi,sigm,chi1,chi2,chip1,chip2,
11110 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
11111 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
11114 ! Calculate gradient components.
11115 e1=e1*eps1*eps2rt**2*eps3rt**2
11116 fac=-expon*(e1+evdwij)
11119 ! Calculate radial part of the gradient
11123 ! Calculate the angular part of the gradient and sum add the contributions
11124 ! to the appropriate components of the Cartesian gradient.
11125 call sc_grad_scale(1.0d0-sss)
11132 end subroutine ebp_long
11133 !-----------------------------------------------------------------------------
11134 subroutine ebp_short(evdw)
11136 ! This subroutine calculates the interaction energy of nonbonded side chains
11137 ! assuming the Berne-Pechukas potential of interaction.
11140 ! implicit real*8 (a-h,o-z)
11141 ! include 'DIMENSIONS'
11142 ! include 'COMMON.GEO'
11143 ! include 'COMMON.VAR'
11144 ! include 'COMMON.LOCAL'
11145 ! include 'COMMON.CHAIN'
11146 ! include 'COMMON.DERIV'
11147 ! include 'COMMON.NAMES'
11148 ! include 'COMMON.INTERACT'
11149 ! include 'COMMON.IOUNITS'
11150 ! include 'COMMON.CALC'
11152 !el integer :: icall
11153 !el common /srutu/ icall
11154 ! double precision rrsave(maxdim)
11156 !el local variables
11157 integer :: iint,itypi,itypi1,itypj
11158 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
11159 real(kind=8) :: sss,e1,e2,evdw
11161 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
11163 ! if (icall.eq.0) then
11169 do i=iatsc_s,iatsc_e
11171 if (itypi.eq.ntyp1) cycle
11176 dxi=dc_norm(1,nres+i)
11177 dyi=dc_norm(2,nres+i)
11178 dzi=dc_norm(3,nres+i)
11179 ! dsci_inv=dsc_inv(itypi)
11180 dsci_inv=vbld_inv(i+nres)
11182 ! Calculate SC interaction energy.
11184 do iint=1,nint_gr(i)
11185 do j=istart(i,iint),iend(i,iint)
11188 if (itypj.eq.ntyp1) cycle
11189 ! dscj_inv=dsc_inv(itypj)
11190 dscj_inv=vbld_inv(j+nres)
11191 chi1=chi(itypi,itypj)
11192 chi2=chi(itypj,itypi)
11199 alf12=0.5D0*(alf1+alf2)
11203 dxj=dc_norm(1,nres+j)
11204 dyj=dc_norm(2,nres+j)
11205 dzj=dc_norm(3,nres+j)
11206 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11208 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11210 if (sss.gt.0.0d0) then
11212 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
11214 ! Calculate whole angle-dependent part of epsilon and contributions
11215 ! to its derivatives
11216 fac=(rrij*sigsq)**expon2
11217 e1=fac*fac*aa(itypi,itypj)
11218 e2=fac*bb(itypi,itypj)
11219 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11220 eps2der=evdwij*eps3rt
11221 eps3der=evdwij*eps2rt
11222 evdwij=evdwij*eps2rt*eps3rt
11223 evdw=evdw+evdwij*sss
11225 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11226 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11227 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
11228 !d & restyp(itypi),i,restyp(itypj),j,
11229 !d & epsi,sigm,chi1,chi2,chip1,chip2,
11230 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
11231 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
11234 ! Calculate gradient components.
11235 e1=e1*eps1*eps2rt**2*eps3rt**2
11236 fac=-expon*(e1+evdwij)
11239 ! Calculate radial part of the gradient
11243 ! Calculate the angular part of the gradient and sum add the contributions
11244 ! to the appropriate components of the Cartesian gradient.
11245 call sc_grad_scale(sss)
11252 end subroutine ebp_short
11253 !-----------------------------------------------------------------------------
11254 subroutine egb_long(evdw)
11256 ! This subroutine calculates the interaction energy of nonbonded side chains
11257 ! assuming the Gay-Berne potential of interaction.
11260 ! implicit real*8 (a-h,o-z)
11261 ! include 'DIMENSIONS'
11262 ! include 'COMMON.GEO'
11263 ! include 'COMMON.VAR'
11264 ! include 'COMMON.LOCAL'
11265 ! include 'COMMON.CHAIN'
11266 ! include 'COMMON.DERIV'
11267 ! include 'COMMON.NAMES'
11268 ! include 'COMMON.INTERACT'
11269 ! include 'COMMON.IOUNITS'
11270 ! include 'COMMON.CALC'
11271 ! include 'COMMON.CONTROL'
11273 !el local variables
11274 integer :: iint,itypi,itypi1,itypj
11275 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
11276 real(kind=8) :: sss,e1,e2,evdw
11278 !cccc energy_dec=.false.
11279 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11282 ! if (icall.eq.0) lprn=.false.
11284 do i=iatsc_s,iatsc_e
11286 if (itypi.eq.ntyp1) cycle
11291 dxi=dc_norm(1,nres+i)
11292 dyi=dc_norm(2,nres+i)
11293 dzi=dc_norm(3,nres+i)
11294 ! dsci_inv=dsc_inv(itypi)
11295 dsci_inv=vbld_inv(i+nres)
11296 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
11297 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
11299 ! Calculate SC interaction energy.
11301 do iint=1,nint_gr(i)
11302 do j=istart(i,iint),iend(i,iint)
11305 if (itypj.eq.ntyp1) cycle
11306 ! dscj_inv=dsc_inv(itypj)
11307 dscj_inv=vbld_inv(j+nres)
11308 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
11309 ! & 1.0d0/vbld(j+nres)
11310 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
11311 sig0ij=sigma(itypi,itypj)
11312 chi1=chi(itypi,itypj)
11313 chi2=chi(itypj,itypi)
11320 alf12=0.5D0*(alf1+alf2)
11324 dxj=dc_norm(1,nres+j)
11325 dyj=dc_norm(2,nres+j)
11326 dzj=dc_norm(3,nres+j)
11327 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11329 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11331 if (sss.lt.1.0d0) then
11333 ! Calculate angle-dependent terms of energy and contributions to their
11337 sig=sig0ij*dsqrt(sigsq)
11338 rij_shift=1.0D0/rij-sig+sig0ij
11339 ! for diagnostics; uncomment
11340 ! rij_shift=1.2*sig0ij
11341 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11342 if (rij_shift.le.0.0D0) then
11344 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
11345 !d & restyp(itypi),i,restyp(itypj),j,
11346 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
11350 !---------------------------------------------------------------
11351 rij_shift=1.0D0/rij_shift
11352 fac=rij_shift**expon
11353 e1=fac*fac*aa(itypi,itypj)
11354 e2=fac*bb(itypi,itypj)
11355 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11356 eps2der=evdwij*eps3rt
11357 eps3der=evdwij*eps2rt
11358 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
11359 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
11360 evdwij=evdwij*eps2rt*eps3rt
11361 evdw=evdw+evdwij*(1.0d0-sss)
11363 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11364 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11365 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11366 restyp(itypi),i,restyp(itypj),j,&
11367 epsi,sigm,chi1,chi2,chip1,chip2,&
11368 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
11369 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11373 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
11375 ! if (energy_dec) write (iout,*) &
11376 ! 'evdw',i,j,evdwij,"egb_long"
11378 ! Calculate gradient components.
11379 e1=e1*eps1*eps2rt**2*eps3rt**2
11380 fac=-expon*(e1+evdwij)*rij_shift
11384 ! Calculate the radial part of the gradient
11388 ! Calculate angular part of the gradient.
11389 call sc_grad_scale(1.0d0-sss)
11394 ! write (iout,*) "Number of loop steps in EGB:",ind
11395 !ccc energy_dec=.false.
11397 end subroutine egb_long
11398 !-----------------------------------------------------------------------------
11399 subroutine egb_short(evdw)
11401 ! This subroutine calculates the interaction energy of nonbonded side chains
11402 ! assuming the Gay-Berne potential of interaction.
11405 ! implicit real*8 (a-h,o-z)
11406 ! include 'DIMENSIONS'
11407 ! include 'COMMON.GEO'
11408 ! include 'COMMON.VAR'
11409 ! include 'COMMON.LOCAL'
11410 ! include 'COMMON.CHAIN'
11411 ! include 'COMMON.DERIV'
11412 ! include 'COMMON.NAMES'
11413 ! include 'COMMON.INTERACT'
11414 ! include 'COMMON.IOUNITS'
11415 ! include 'COMMON.CALC'
11416 ! include 'COMMON.CONTROL'
11418 !el local variables
11419 integer :: iint,itypi,itypi1,itypj
11420 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
11421 real(kind=8) :: sss,e1,e2,evdw,rij_shift
11423 !cccc energy_dec=.false.
11424 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11427 ! if (icall.eq.0) lprn=.false.
11429 do i=iatsc_s,iatsc_e
11431 if (itypi.eq.ntyp1) cycle
11436 dxi=dc_norm(1,nres+i)
11437 dyi=dc_norm(2,nres+i)
11438 dzi=dc_norm(3,nres+i)
11439 ! dsci_inv=dsc_inv(itypi)
11440 dsci_inv=vbld_inv(i+nres)
11441 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
11442 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
11444 ! Calculate SC interaction energy.
11446 do iint=1,nint_gr(i)
11447 do j=istart(i,iint),iend(i,iint)
11450 if (itypj.eq.ntyp1) cycle
11451 ! dscj_inv=dsc_inv(itypj)
11452 dscj_inv=vbld_inv(j+nres)
11453 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
11454 ! & 1.0d0/vbld(j+nres)
11455 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
11456 sig0ij=sigma(itypi,itypj)
11457 chi1=chi(itypi,itypj)
11458 chi2=chi(itypj,itypi)
11465 alf12=0.5D0*(alf1+alf2)
11469 dxj=dc_norm(1,nres+j)
11470 dyj=dc_norm(2,nres+j)
11471 dzj=dc_norm(3,nres+j)
11472 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11474 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11476 if (sss.gt.0.0d0) then
11478 ! Calculate angle-dependent terms of energy and contributions to their
11482 sig=sig0ij*dsqrt(sigsq)
11483 rij_shift=1.0D0/rij-sig+sig0ij
11484 ! for diagnostics; uncomment
11485 ! rij_shift=1.2*sig0ij
11486 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11487 if (rij_shift.le.0.0D0) then
11489 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
11490 !d & restyp(itypi),i,restyp(itypj),j,
11491 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
11495 !---------------------------------------------------------------
11496 rij_shift=1.0D0/rij_shift
11497 fac=rij_shift**expon
11498 e1=fac*fac*aa(itypi,itypj)
11499 e2=fac*bb(itypi,itypj)
11500 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11501 eps2der=evdwij*eps3rt
11502 eps3der=evdwij*eps2rt
11503 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
11504 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
11505 evdwij=evdwij*eps2rt*eps3rt
11506 evdw=evdw+evdwij*sss
11508 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11509 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11510 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11511 restyp(itypi),i,restyp(itypj),j,&
11512 epsi,sigm,chi1,chi2,chip1,chip2,&
11513 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
11514 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11518 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
11520 ! if (energy_dec) write (iout,*) &
11521 ! 'evdw',i,j,evdwij,"egb_short"
11523 ! Calculate gradient components.
11524 e1=e1*eps1*eps2rt**2*eps3rt**2
11525 fac=-expon*(e1+evdwij)*rij_shift
11529 ! Calculate the radial part of the gradient
11533 ! Calculate angular part of the gradient.
11534 call sc_grad_scale(sss)
11539 ! write (iout,*) "Number of loop steps in EGB:",ind
11540 !ccc energy_dec=.false.
11542 end subroutine egb_short
11543 !-----------------------------------------------------------------------------
11544 subroutine egbv_long(evdw)
11546 ! This subroutine calculates the interaction energy of nonbonded side chains
11547 ! assuming the Gay-Berne-Vorobjev potential of interaction.
11550 ! implicit real*8 (a-h,o-z)
11551 ! include 'DIMENSIONS'
11552 ! include 'COMMON.GEO'
11553 ! include 'COMMON.VAR'
11554 ! include 'COMMON.LOCAL'
11555 ! include 'COMMON.CHAIN'
11556 ! include 'COMMON.DERIV'
11557 ! include 'COMMON.NAMES'
11558 ! include 'COMMON.INTERACT'
11559 ! include 'COMMON.IOUNITS'
11560 ! include 'COMMON.CALC'
11562 !el integer :: icall
11563 !el common /srutu/ icall
11565 !el local variables
11566 integer :: iint,itypi,itypi1,itypj
11567 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
11568 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
11570 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11573 ! if (icall.eq.0) lprn=.true.
11575 do i=iatsc_s,iatsc_e
11577 if (itypi.eq.ntyp1) cycle
11582 dxi=dc_norm(1,nres+i)
11583 dyi=dc_norm(2,nres+i)
11584 dzi=dc_norm(3,nres+i)
11585 ! dsci_inv=dsc_inv(itypi)
11586 dsci_inv=vbld_inv(i+nres)
11588 ! Calculate SC interaction energy.
11590 do iint=1,nint_gr(i)
11591 do j=istart(i,iint),iend(i,iint)
11594 if (itypj.eq.ntyp1) cycle
11595 ! dscj_inv=dsc_inv(itypj)
11596 dscj_inv=vbld_inv(j+nres)
11597 sig0ij=sigma(itypi,itypj)
11598 r0ij=r0(itypi,itypj)
11599 chi1=chi(itypi,itypj)
11600 chi2=chi(itypj,itypi)
11607 alf12=0.5D0*(alf1+alf2)
11611 dxj=dc_norm(1,nres+j)
11612 dyj=dc_norm(2,nres+j)
11613 dzj=dc_norm(3,nres+j)
11614 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11617 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11619 if (sss.lt.1.0d0) then
11621 ! Calculate angle-dependent terms of energy and contributions to their
11625 sig=sig0ij*dsqrt(sigsq)
11626 rij_shift=1.0D0/rij-sig+r0ij
11627 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11628 if (rij_shift.le.0.0D0) then
11633 !---------------------------------------------------------------
11634 rij_shift=1.0D0/rij_shift
11635 fac=rij_shift**expon
11636 e1=fac*fac*aa(itypi,itypj)
11637 e2=fac*bb(itypi,itypj)
11638 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11639 eps2der=evdwij*eps3rt
11640 eps3der=evdwij*eps2rt
11641 fac_augm=rrij**expon
11642 e_augm=augm(itypi,itypj)*fac_augm
11643 evdwij=evdwij*eps2rt*eps3rt
11644 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
11646 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11647 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11648 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11649 restyp(itypi),i,restyp(itypj),j,&
11650 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
11651 chi1,chi2,chip1,chip2,&
11652 eps1,eps2rt**2,eps3rt**2,&
11653 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11656 ! Calculate gradient components.
11657 e1=e1*eps1*eps2rt**2*eps3rt**2
11658 fac=-expon*(e1+evdwij)*rij_shift
11660 fac=rij*fac-2*expon*rrij*e_augm
11661 ! Calculate the radial part of the gradient
11665 ! Calculate angular part of the gradient.
11666 call sc_grad_scale(1.0d0-sss)
11671 end subroutine egbv_long
11672 !-----------------------------------------------------------------------------
11673 subroutine egbv_short(evdw)
11675 ! This subroutine calculates the interaction energy of nonbonded side chains
11676 ! assuming the Gay-Berne-Vorobjev potential of interaction.
11679 ! implicit real*8 (a-h,o-z)
11680 ! include 'DIMENSIONS'
11681 ! include 'COMMON.GEO'
11682 ! include 'COMMON.VAR'
11683 ! include 'COMMON.LOCAL'
11684 ! include 'COMMON.CHAIN'
11685 ! include 'COMMON.DERIV'
11686 ! include 'COMMON.NAMES'
11687 ! include 'COMMON.INTERACT'
11688 ! include 'COMMON.IOUNITS'
11689 ! include 'COMMON.CALC'
11691 !el integer :: icall
11692 !el common /srutu/ icall
11694 !el local variables
11695 integer :: iint,itypi,itypi1,itypj
11696 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
11697 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
11699 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11702 ! if (icall.eq.0) lprn=.true.
11704 do i=iatsc_s,iatsc_e
11706 if (itypi.eq.ntyp1) cycle
11711 dxi=dc_norm(1,nres+i)
11712 dyi=dc_norm(2,nres+i)
11713 dzi=dc_norm(3,nres+i)
11714 ! dsci_inv=dsc_inv(itypi)
11715 dsci_inv=vbld_inv(i+nres)
11717 ! Calculate SC interaction energy.
11719 do iint=1,nint_gr(i)
11720 do j=istart(i,iint),iend(i,iint)
11723 if (itypj.eq.ntyp1) cycle
11724 ! dscj_inv=dsc_inv(itypj)
11725 dscj_inv=vbld_inv(j+nres)
11726 sig0ij=sigma(itypi,itypj)
11727 r0ij=r0(itypi,itypj)
11728 chi1=chi(itypi,itypj)
11729 chi2=chi(itypj,itypi)
11736 alf12=0.5D0*(alf1+alf2)
11740 dxj=dc_norm(1,nres+j)
11741 dyj=dc_norm(2,nres+j)
11742 dzj=dc_norm(3,nres+j)
11743 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11746 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11748 if (sss.gt.0.0d0) then
11750 ! Calculate angle-dependent terms of energy and contributions to their
11754 sig=sig0ij*dsqrt(sigsq)
11755 rij_shift=1.0D0/rij-sig+r0ij
11756 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11757 if (rij_shift.le.0.0D0) then
11762 !---------------------------------------------------------------
11763 rij_shift=1.0D0/rij_shift
11764 fac=rij_shift**expon
11765 e1=fac*fac*aa(itypi,itypj)
11766 e2=fac*bb(itypi,itypj)
11767 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11768 eps2der=evdwij*eps3rt
11769 eps3der=evdwij*eps2rt
11770 fac_augm=rrij**expon
11771 e_augm=augm(itypi,itypj)*fac_augm
11772 evdwij=evdwij*eps2rt*eps3rt
11773 evdw=evdw+(evdwij+e_augm)*sss
11775 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11776 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11777 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11778 restyp(itypi),i,restyp(itypj),j,&
11779 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
11780 chi1,chi2,chip1,chip2,&
11781 eps1,eps2rt**2,eps3rt**2,&
11782 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11785 ! Calculate gradient components.
11786 e1=e1*eps1*eps2rt**2*eps3rt**2
11787 fac=-expon*(e1+evdwij)*rij_shift
11789 fac=rij*fac-2*expon*rrij*e_augm
11790 ! Calculate the radial part of the gradient
11794 ! Calculate angular part of the gradient.
11795 call sc_grad_scale(sss)
11800 end subroutine egbv_short
11801 !-----------------------------------------------------------------------------
11802 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
11804 ! This subroutine calculates the average interaction energy and its gradient
11805 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
11806 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
11807 ! The potential depends both on the distance of peptide-group centers and on
11808 ! the orientation of the CA-CA virtual bonds.
11810 ! implicit real*8 (a-h,o-z)
11816 ! include 'DIMENSIONS'
11817 ! include 'COMMON.CONTROL'
11818 ! include 'COMMON.SETUP'
11819 ! include 'COMMON.IOUNITS'
11820 ! include 'COMMON.GEO'
11821 ! include 'COMMON.VAR'
11822 ! include 'COMMON.LOCAL'
11823 ! include 'COMMON.CHAIN'
11824 ! include 'COMMON.DERIV'
11825 ! include 'COMMON.INTERACT'
11826 ! include 'COMMON.CONTACTS'
11827 ! include 'COMMON.TORSION'
11828 ! include 'COMMON.VECTORS'
11829 ! include 'COMMON.FFIELD'
11830 ! include 'COMMON.TIME1'
11831 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
11832 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
11833 real(kind=8),dimension(2,2) :: acipa !el,a_temp
11834 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
11835 real(kind=8),dimension(4) :: muij
11836 !el integer :: num_conti,j1,j2
11837 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
11838 !el dz_normi,xmedi,ymedi,zmedi
11839 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
11840 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
11841 !el num_conti,j1,j2
11842 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
11844 real(kind=8) :: scal_el=1.0d0
11846 real(kind=8) :: scal_el=0.5d0
11849 ! 13-go grudnia roku pamietnego...
11850 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
11851 0.0d0,1.0d0,0.0d0,&
11852 0.0d0,0.0d0,1.0d0/),shape(unmat))
11853 !el local variables
11855 real(kind=8) :: fac
11856 real(kind=8) :: dxj,dyj,dzj
11857 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
11859 ! allocate(num_cont_hb(nres)) !(maxres)
11860 !d write(iout,*) 'In EELEC'
11862 !d write(iout,*) 'Type',i
11863 !d write(iout,*) 'B1',B1(:,i)
11864 !d write(iout,*) 'B2',B2(:,i)
11865 !d write(iout,*) 'CC',CC(:,:,i)
11866 !d write(iout,*) 'DD',DD(:,:,i)
11867 !d write(iout,*) 'EE',EE(:,:,i)
11869 !d call check_vecgrad
11871 if (icheckgrad.eq.1) then
11873 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
11875 dc_norm(k,i)=dc(k,i)*fac
11877 ! write (iout,*) 'i',i,' fac',fac
11880 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
11881 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
11882 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
11883 ! call vec_and_deriv
11889 time_mat=time_mat+MPI_Wtime()-time01
11893 !d write (iout,*) 'i=',i
11895 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
11898 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
11899 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
11912 !d print '(a)','Enter EELEC'
11913 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
11914 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
11915 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
11917 gel_loc_loc(i)=0.0d0
11922 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
11924 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
11926 do i=iturn3_start,iturn3_end
11927 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1 &
11928 .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
11932 dx_normi=dc_norm(1,i)
11933 dy_normi=dc_norm(2,i)
11934 dz_normi=dc_norm(3,i)
11935 xmedi=c(1,i)+0.5d0*dxi
11936 ymedi=c(2,i)+0.5d0*dyi
11937 zmedi=c(3,i)+0.5d0*dzi
11939 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
11940 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
11941 num_cont_hb(i)=num_conti
11943 do i=iturn4_start,iturn4_end
11944 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
11945 .or. itype(i+3).eq.ntyp1 &
11946 .or. itype(i+4).eq.ntyp1) cycle
11950 dx_normi=dc_norm(1,i)
11951 dy_normi=dc_norm(2,i)
11952 dz_normi=dc_norm(3,i)
11953 xmedi=c(1,i)+0.5d0*dxi
11954 ymedi=c(2,i)+0.5d0*dyi
11955 zmedi=c(3,i)+0.5d0*dzi
11956 num_conti=num_cont_hb(i)
11957 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
11958 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
11959 call eturn4(i,eello_turn4)
11960 num_cont_hb(i)=num_conti
11963 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
11965 do i=iatel_s,iatel_e
11966 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
11970 dx_normi=dc_norm(1,i)
11971 dy_normi=dc_norm(2,i)
11972 dz_normi=dc_norm(3,i)
11973 xmedi=c(1,i)+0.5d0*dxi
11974 ymedi=c(2,i)+0.5d0*dyi
11975 zmedi=c(3,i)+0.5d0*dzi
11976 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
11977 num_conti=num_cont_hb(i)
11978 do j=ielstart(i),ielend(i)
11979 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
11980 call eelecij_scale(i,j,ees,evdw1,eel_loc)
11982 num_cont_hb(i)=num_conti
11984 ! write (iout,*) "Number of loop steps in EELEC:",ind
11986 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
11987 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
11989 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
11990 !cc eel_loc=eel_loc+eello_turn3
11991 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
11993 end subroutine eelec_scale
11994 !-----------------------------------------------------------------------------
11995 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
11996 ! implicit real*8 (a-h,o-z)
11999 ! include 'DIMENSIONS'
12003 ! include 'COMMON.CONTROL'
12004 ! include 'COMMON.IOUNITS'
12005 ! include 'COMMON.GEO'
12006 ! include 'COMMON.VAR'
12007 ! include 'COMMON.LOCAL'
12008 ! include 'COMMON.CHAIN'
12009 ! include 'COMMON.DERIV'
12010 ! include 'COMMON.INTERACT'
12011 ! include 'COMMON.CONTACTS'
12012 ! include 'COMMON.TORSION'
12013 ! include 'COMMON.VECTORS'
12014 ! include 'COMMON.FFIELD'
12015 ! include 'COMMON.TIME1'
12016 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
12017 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
12018 real(kind=8),dimension(2,2) :: acipa !el,a_temp
12019 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
12020 real(kind=8),dimension(4) :: muij
12021 !el integer :: num_conti,j1,j2
12022 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
12023 !el dz_normi,xmedi,ymedi,zmedi
12024 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
12025 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
12026 !el num_conti,j1,j2
12027 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
12029 real(kind=8) :: scal_el=1.0d0
12031 real(kind=8) :: scal_el=0.5d0
12034 ! 13-go grudnia roku pamietnego...
12035 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
12036 0.0d0,1.0d0,0.0d0,&
12037 0.0d0,0.0d0,1.0d0/),shape(unmat))
12038 !el local variables
12039 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m
12040 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
12041 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
12042 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
12043 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
12044 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
12045 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
12046 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
12047 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
12048 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
12049 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
12050 ecosam,ecosbm,ecosgm,ghalf,time00
12051 ! integer :: maxconts
12052 ! maxconts = nres/4
12053 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12054 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12055 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12056 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12057 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12058 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12059 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12060 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12061 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
12062 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
12063 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
12064 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
12065 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
12067 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
12068 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
12073 !d write (iout,*) "eelecij",i,j
12077 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
12078 aaa=app(iteli,itelj)
12079 bbb=bpp(iteli,itelj)
12080 ael6i=ael6(iteli,itelj)
12081 ael3i=ael3(iteli,itelj)
12085 dx_normj=dc_norm(1,j)
12086 dy_normj=dc_norm(2,j)
12087 dz_normj=dc_norm(3,j)
12088 xj=c(1,j)+0.5D0*dxj-xmedi
12089 yj=c(2,j)+0.5D0*dyj-ymedi
12090 zj=c(3,j)+0.5D0*dzj-zmedi
12091 rij=xj*xj+yj*yj+zj*zj
12095 ! For extracting the short-range part of Evdwpp
12096 sss=sscale(rij/rpp(iteli,itelj))
12100 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
12101 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
12102 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
12103 fac=cosa-3.0D0*cosb*cosg
12105 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
12106 if (j.eq.i+2) ev1=scal_el*ev1
12111 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
12114 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
12115 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
12117 evdw1=evdw1+evdwij*(1.0d0-sss)
12118 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
12119 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
12120 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
12121 !d & xmedi,ymedi,zmedi,xj,yj,zj
12123 if (energy_dec) then
12124 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
12125 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
12129 ! Calculate contributions to the Cartesian gradient.
12132 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)
12133 facel=-3*rrmij*(el1+eesij)
12139 ! Radial derivatives. First process both termini of the fragment (i,j)
12145 ! ghalf=0.5D0*ggg(k)
12146 ! gelc(k,i)=gelc(k,i)+ghalf
12147 ! gelc(k,j)=gelc(k,j)+ghalf
12149 ! 9/28/08 AL Gradient compotents will be summed only at the end
12151 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
12152 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
12155 ! Loop over residues i+1 thru j-1.
12159 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12166 ! ghalf=0.5D0*ggg(k)
12167 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
12168 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
12170 ! 9/28/08 AL Gradient compotents will be summed only at the end
12172 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12173 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12176 ! Loop over residues i+1 thru j-1.
12180 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
12184 facvdw=ev1+evdwij*(1.0d0-sss)
12187 fac=-3*rrmij*(facvdw+facvdw+facel)
12192 ! Radial derivatives. First process both termini of the fragment (i,j)
12198 ! ghalf=0.5D0*ggg(k)
12199 ! gelc(k,i)=gelc(k,i)+ghalf
12200 ! gelc(k,j)=gelc(k,j)+ghalf
12202 ! 9/28/08 AL Gradient compotents will be summed only at the end
12204 gelc_long(k,j)=gelc(k,j)+ggg(k)
12205 gelc_long(k,i)=gelc(k,i)-ggg(k)
12208 ! Loop over residues i+1 thru j-1.
12212 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12215 ! 9/28/08 AL Gradient compotents will be summed only at the end
12220 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12221 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12227 ecosa=2.0D0*fac3*fac1+fac4
12230 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
12231 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
12233 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
12234 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
12236 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
12237 !d & (dcosg(k),k=1,3)
12239 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
12242 ! ghalf=0.5D0*ggg(k)
12243 ! gelc(k,i)=gelc(k,i)+ghalf
12244 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
12245 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12246 ! gelc(k,j)=gelc(k,j)+ghalf
12247 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
12248 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12252 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12256 gelc(k,i)=gelc(k,i) &
12257 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
12258 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12259 gelc(k,j)=gelc(k,j) &
12260 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
12261 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12262 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
12263 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
12265 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
12266 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
12267 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
12269 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
12270 ! energy of a peptide unit is assumed in the form of a second-order
12271 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
12272 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
12273 ! are computed for EVERY pair of non-contiguous peptide groups.
12275 if (j.lt.nres-1) then
12286 muij(kkk)=mu(k,i)*mu(l,j)
12289 !d write (iout,*) 'EELEC: i',i,' j',j
12290 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
12291 !d write(iout,*) 'muij',muij
12292 ury=scalar(uy(1,i),erij)
12293 urz=scalar(uz(1,i),erij)
12294 vry=scalar(uy(1,j),erij)
12295 vrz=scalar(uz(1,j),erij)
12296 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
12297 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
12298 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
12299 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
12300 fac=dsqrt(-ael6i)*r3ij
12305 !d write (iout,'(4i5,4f10.5)')
12306 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
12307 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
12308 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
12309 !d & uy(:,j),uz(:,j)
12310 !d write (iout,'(4f10.5)')
12311 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
12312 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
12313 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
12314 !d write (iout,'(9f10.5/)')
12315 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
12316 ! Derivatives of the elements of A in virtual-bond vectors
12317 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
12319 uryg(k,1)=scalar(erder(1,k),uy(1,i))
12320 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
12321 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
12322 urzg(k,1)=scalar(erder(1,k),uz(1,i))
12323 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
12324 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
12325 vryg(k,1)=scalar(erder(1,k),uy(1,j))
12326 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
12327 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
12328 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
12329 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
12330 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
12332 ! Compute radial contributions to the gradient
12350 ! Add the contributions coming from er
12353 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
12354 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
12355 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
12356 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
12359 ! Derivatives in DC(i)
12360 !grad ghalf1=0.5d0*agg(k,1)
12361 !grad ghalf2=0.5d0*agg(k,2)
12362 !grad ghalf3=0.5d0*agg(k,3)
12363 !grad ghalf4=0.5d0*agg(k,4)
12364 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
12365 -3.0d0*uryg(k,2)*vry)!+ghalf1
12366 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
12367 -3.0d0*uryg(k,2)*vrz)!+ghalf2
12368 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
12369 -3.0d0*urzg(k,2)*vry)!+ghalf3
12370 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
12371 -3.0d0*urzg(k,2)*vrz)!+ghalf4
12372 ! Derivatives in DC(i+1)
12373 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
12374 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
12375 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
12376 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
12377 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
12378 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
12379 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
12380 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
12381 ! Derivatives in DC(j)
12382 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
12383 -3.0d0*vryg(k,2)*ury)!+ghalf1
12384 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
12385 -3.0d0*vrzg(k,2)*ury)!+ghalf2
12386 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
12387 -3.0d0*vryg(k,2)*urz)!+ghalf3
12388 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
12389 -3.0d0*vrzg(k,2)*urz)!+ghalf4
12390 ! Derivatives in DC(j+1) or DC(nres-1)
12391 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
12392 -3.0d0*vryg(k,3)*ury)
12393 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
12394 -3.0d0*vrzg(k,3)*ury)
12395 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
12396 -3.0d0*vryg(k,3)*urz)
12397 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
12398 -3.0d0*vrzg(k,3)*urz)
12399 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
12401 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
12414 aggi(k,l)=-aggi(k,l)
12415 aggi1(k,l)=-aggi1(k,l)
12416 aggj(k,l)=-aggj(k,l)
12417 aggj1(k,l)=-aggj1(k,l)
12420 if (j.lt.nres-1) then
12426 aggi(k,l)=-aggi(k,l)
12427 aggi1(k,l)=-aggi1(k,l)
12428 aggj(k,l)=-aggj(k,l)
12429 aggj1(k,l)=-aggj1(k,l)
12440 aggi(k,l)=-aggi(k,l)
12441 aggi1(k,l)=-aggi1(k,l)
12442 aggj(k,l)=-aggj(k,l)
12443 aggj1(k,l)=-aggj1(k,l)
12448 IF (wel_loc.gt.0.0d0) THEN
12449 ! Contribution to the local-electrostatic energy coming from the i-j pair
12450 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
12452 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
12454 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
12455 'eelloc',i,j,eel_loc_ij
12456 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
12458 eel_loc=eel_loc+eel_loc_ij
12459 ! Partial derivatives in virtual-bond dihedral angles gamma
12461 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
12462 a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
12463 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
12464 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
12465 a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
12466 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
12467 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
12469 ggg(l)=agg(l,1)*muij(1)+ &
12470 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
12471 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
12472 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
12473 !grad ghalf=0.5d0*ggg(l)
12474 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
12475 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
12479 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
12482 ! Remaining derivatives of eello
12484 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ &
12485 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
12486 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ &
12487 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
12488 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ &
12489 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
12490 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ &
12491 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
12494 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
12495 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
12496 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
12497 .and. num_conti.le.maxconts) then
12498 ! write (iout,*) i,j," entered corr"
12500 ! Calculate the contact function. The ith column of the array JCONT will
12501 ! contain the numbers of atoms that make contacts with the atom I (of numbers
12502 ! greater than I). The arrays FACONT and GACONT will contain the values of
12503 ! the contact function and its derivative.
12504 ! r0ij=1.02D0*rpp(iteli,itelj)
12505 ! r0ij=1.11D0*rpp(iteli,itelj)
12506 r0ij=2.20D0*rpp(iteli,itelj)
12507 ! r0ij=1.55D0*rpp(iteli,itelj)
12508 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
12509 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
12510 if (fcont.gt.0.0D0) then
12511 num_conti=num_conti+1
12512 if (num_conti.gt.maxconts) then
12513 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
12514 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
12515 ' will skip next contacts for this conf.',num_conti
12517 jcont_hb(num_conti,i)=j
12518 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
12519 !d & " jcont_hb",jcont_hb(num_conti,i)
12520 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
12521 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
12522 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
12524 d_cont(num_conti,i)=rij
12525 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
12526 ! --- Electrostatic-interaction matrix ---
12527 a_chuj(1,1,num_conti,i)=a22
12528 a_chuj(1,2,num_conti,i)=a23
12529 a_chuj(2,1,num_conti,i)=a32
12530 a_chuj(2,2,num_conti,i)=a33
12531 ! --- Gradient of rij
12533 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
12540 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
12541 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
12542 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
12543 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
12544 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
12549 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
12550 ! Calculate contact energies
12552 wij=cosa-3.0D0*cosb*cosg
12555 ! fac3=dsqrt(-ael6i)/r0ij**3
12556 fac3=dsqrt(-ael6i)*r3ij
12557 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
12558 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
12559 if (ees0tmp.gt.0) then
12560 ees0pij=dsqrt(ees0tmp)
12564 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
12565 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
12566 if (ees0tmp.gt.0) then
12567 ees0mij=dsqrt(ees0tmp)
12572 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
12573 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
12574 ! Diagnostics. Comment out or remove after debugging!
12575 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
12576 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
12577 ! ees0m(num_conti,i)=0.0D0
12579 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
12580 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
12581 ! Angular derivatives of the contact function
12582 ees0pij1=fac3/ees0pij
12583 ees0mij1=fac3/ees0mij
12584 fac3p=-3.0D0*fac3*rrmij
12585 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
12586 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
12588 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
12589 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
12590 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
12591 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
12592 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
12593 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
12594 ecosap=ecosa1+ecosa2
12595 ecosbp=ecosb1+ecosb2
12596 ecosgp=ecosg1+ecosg2
12597 ecosam=ecosa1-ecosa2
12598 ecosbm=ecosb1-ecosb2
12599 ecosgm=ecosg1-ecosg2
12608 facont_hb(num_conti,i)=fcont
12609 fprimcont=fprimcont/rij
12610 !d facont_hb(num_conti,i)=1.0D0
12611 ! Following line is for diagnostics.
12614 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
12615 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
12618 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
12619 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
12621 gggp(1)=gggp(1)+ees0pijp*xj
12622 gggp(2)=gggp(2)+ees0pijp*yj
12623 gggp(3)=gggp(3)+ees0pijp*zj
12624 gggm(1)=gggm(1)+ees0mijp*xj
12625 gggm(2)=gggm(2)+ees0mijp*yj
12626 gggm(3)=gggm(3)+ees0mijp*zj
12627 ! Derivatives due to the contact function
12628 gacont_hbr(1,num_conti,i)=fprimcont*xj
12629 gacont_hbr(2,num_conti,i)=fprimcont*yj
12630 gacont_hbr(3,num_conti,i)=fprimcont*zj
12633 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
12634 ! following the change of gradient-summation algorithm.
12636 !grad ghalfp=0.5D0*gggp(k)
12637 !grad ghalfm=0.5D0*gggm(k)
12638 gacontp_hb1(k,num_conti,i)= & !ghalfp
12639 +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
12640 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12641 gacontp_hb2(k,num_conti,i)= & !ghalfp
12642 +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
12643 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12644 gacontp_hb3(k,num_conti,i)=gggp(k)
12645 gacontm_hb1(k,num_conti,i)= &!ghalfm
12646 +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
12647 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12648 gacontm_hb2(k,num_conti,i)= & !ghalfm
12649 +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
12650 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12651 gacontm_hb3(k,num_conti,i)=gggm(k)
12654 endif ! num_conti.le.maxconts
12657 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
12660 ghalf=0.5d0*agg(l,k)
12661 aggi(l,k)=aggi(l,k)+ghalf
12662 aggi1(l,k)=aggi1(l,k)+agg(l,k)
12663 aggj(l,k)=aggj(l,k)+ghalf
12666 if (j.eq.nres-1 .and. i.lt.j-2) then
12669 aggj1(l,k)=aggj1(l,k)+agg(l,k)
12674 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
12676 end subroutine eelecij_scale
12677 !-----------------------------------------------------------------------------
12678 subroutine evdwpp_short(evdw1)
12682 ! implicit real*8 (a-h,o-z)
12683 ! include 'DIMENSIONS'
12684 ! include 'COMMON.CONTROL'
12685 ! include 'COMMON.IOUNITS'
12686 ! include 'COMMON.GEO'
12687 ! include 'COMMON.VAR'
12688 ! include 'COMMON.LOCAL'
12689 ! include 'COMMON.CHAIN'
12690 ! include 'COMMON.DERIV'
12691 ! include 'COMMON.INTERACT'
12692 ! include 'COMMON.CONTACTS'
12693 ! include 'COMMON.TORSION'
12694 ! include 'COMMON.VECTORS'
12695 ! include 'COMMON.FFIELD'
12696 real(kind=8),dimension(3) :: ggg
12697 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
12699 real(kind=8) :: scal_el=1.0d0
12701 real(kind=8) :: scal_el=0.5d0
12703 !el local variables
12704 integer :: i,j,k,iteli,itelj,num_conti
12705 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
12706 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
12707 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
12708 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
12711 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
12712 ! & " iatel_e_vdw",iatel_e_vdw
12714 do i=iatel_s_vdw,iatel_e_vdw
12715 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle
12719 dx_normi=dc_norm(1,i)
12720 dy_normi=dc_norm(2,i)
12721 dz_normi=dc_norm(3,i)
12722 xmedi=c(1,i)+0.5d0*dxi
12723 ymedi=c(2,i)+0.5d0*dyi
12724 zmedi=c(3,i)+0.5d0*dzi
12726 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
12727 ! & ' ielend',ielend_vdw(i)
12729 do j=ielstart_vdw(i),ielend_vdw(i)
12730 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
12734 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
12735 aaa=app(iteli,itelj)
12736 bbb=bpp(iteli,itelj)
12740 dx_normj=dc_norm(1,j)
12741 dy_normj=dc_norm(2,j)
12742 dz_normj=dc_norm(3,j)
12743 xj=c(1,j)+0.5D0*dxj-xmedi
12744 yj=c(2,j)+0.5D0*dyj-ymedi
12745 zj=c(3,j)+0.5D0*dzj-zmedi
12746 rij=xj*xj+yj*yj+zj*zj
12749 sss=sscale(rij/rpp(iteli,itelj))
12750 if (sss.gt.0.0d0) then
12755 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
12756 if (j.eq.i+2) ev1=scal_el*ev1
12759 if (energy_dec) then
12760 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
12762 evdw1=evdw1+evdwij*sss
12764 ! Calculate contributions to the Cartesian gradient.
12766 facvdw=-6*rrmij*(ev1+evdwij)*sss
12771 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12772 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12778 end subroutine evdwpp_short
12779 !-----------------------------------------------------------------------------
12780 subroutine escp_long(evdw2,evdw2_14)
12782 ! This subroutine calculates the excluded-volume interaction energy between
12783 ! peptide-group centers and side chains and its gradient in virtual-bond and
12784 ! side-chain vectors.
12786 ! implicit real*8 (a-h,o-z)
12787 ! include 'DIMENSIONS'
12788 ! include 'COMMON.GEO'
12789 ! include 'COMMON.VAR'
12790 ! include 'COMMON.LOCAL'
12791 ! include 'COMMON.CHAIN'
12792 ! include 'COMMON.DERIV'
12793 ! include 'COMMON.INTERACT'
12794 ! include 'COMMON.FFIELD'
12795 ! include 'COMMON.IOUNITS'
12796 ! include 'COMMON.CONTROL'
12797 real(kind=8),dimension(3) :: ggg
12798 !el local variables
12799 integer :: i,iint,j,k,iteli,itypj
12800 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2
12801 real(kind=8) :: evdw2,evdw2_14,evdwij
12804 !d print '(a)','Enter ESCP'
12805 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
12806 do i=iatscp_s,iatscp_e
12807 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
12809 xi=0.5D0*(c(1,i)+c(1,i+1))
12810 yi=0.5D0*(c(2,i)+c(2,i+1))
12811 zi=0.5D0*(c(3,i)+c(3,i+1))
12813 do iint=1,nscp_gr(i)
12815 do j=iscpstart(i,iint),iscpend(i,iint)
12817 if (itypj.eq.ntyp1) cycle
12818 ! Uncomment following three lines for SC-p interactions
12819 ! xj=c(1,nres+j)-xi
12820 ! yj=c(2,nres+j)-yi
12821 ! zj=c(3,nres+j)-zi
12822 ! Uncomment following three lines for Ca-p interactions
12826 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12828 sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
12830 if (sss.lt.1.0d0) then
12833 e1=fac*fac*aad(itypj,iteli)
12834 e2=fac*bad(itypj,iteli)
12835 if (iabs(j-i) .le. 2) then
12838 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)
12841 evdw2=evdw2+evdwij*(1.0d0-sss)
12842 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
12843 'evdw2',i,j,sss,evdwij
12845 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
12847 fac=-(evdwij+e1)*rrij*(1.0d0-sss)
12851 ! Uncomment following three lines for SC-p interactions
12853 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
12855 ! Uncomment following line for SC-p interactions
12856 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
12858 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
12859 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
12868 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
12869 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
12870 gradx_scp(j,i)=expon*gradx_scp(j,i)
12873 !******************************************************************************
12877 ! To save time the factor EXPON has been extracted from ALL components
12878 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12881 !******************************************************************************
12883 end subroutine escp_long
12884 !-----------------------------------------------------------------------------
12885 subroutine escp_short(evdw2,evdw2_14)
12887 ! This subroutine calculates the excluded-volume interaction energy between
12888 ! peptide-group centers and side chains and its gradient in virtual-bond and
12889 ! side-chain vectors.
12891 ! implicit real*8 (a-h,o-z)
12892 ! include 'DIMENSIONS'
12893 ! include 'COMMON.GEO'
12894 ! include 'COMMON.VAR'
12895 ! include 'COMMON.LOCAL'
12896 ! include 'COMMON.CHAIN'
12897 ! include 'COMMON.DERIV'
12898 ! include 'COMMON.INTERACT'
12899 ! include 'COMMON.FFIELD'
12900 ! include 'COMMON.IOUNITS'
12901 ! include 'COMMON.CONTROL'
12902 real(kind=8),dimension(3) :: ggg
12903 !el local variables
12904 integer :: i,iint,j,k,iteli,itypj
12905 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2
12906 real(kind=8) :: evdw2,evdw2_14,evdwij
12909 !d print '(a)','Enter ESCP'
12910 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
12911 do i=iatscp_s,iatscp_e
12912 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
12914 xi=0.5D0*(c(1,i)+c(1,i+1))
12915 yi=0.5D0*(c(2,i)+c(2,i+1))
12916 zi=0.5D0*(c(3,i)+c(3,i+1))
12918 do iint=1,nscp_gr(i)
12920 do j=iscpstart(i,iint),iscpend(i,iint)
12922 if (itypj.eq.ntyp1) cycle
12923 ! Uncomment following three lines for SC-p interactions
12924 ! xj=c(1,nres+j)-xi
12925 ! yj=c(2,nres+j)-yi
12926 ! zj=c(3,nres+j)-zi
12927 ! Uncomment following three lines for Ca-p interactions
12931 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12933 sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
12935 if (sss.gt.0.0d0) then
12938 e1=fac*fac*aad(itypj,iteli)
12939 e2=fac*bad(itypj,iteli)
12940 if (iabs(j-i) .le. 2) then
12943 evdw2_14=evdw2_14+(e1+e2)*sss
12946 evdw2=evdw2+evdwij*sss
12947 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
12948 'evdw2',i,j,sss,evdwij
12950 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
12952 fac=-(evdwij+e1)*rrij*sss
12956 ! Uncomment following three lines for SC-p interactions
12958 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
12960 ! Uncomment following line for SC-p interactions
12961 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
12963 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
12964 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
12973 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
12974 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
12975 gradx_scp(j,i)=expon*gradx_scp(j,i)
12978 !******************************************************************************
12982 ! To save time the factor EXPON has been extracted from ALL components
12983 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12986 !******************************************************************************
12988 end subroutine escp_short
12989 !-----------------------------------------------------------------------------
12990 ! energy_p_new-sep_barrier.F
12991 !-----------------------------------------------------------------------------
12992 subroutine sc_grad_scale(scalfac)
12993 ! implicit real*8 (a-h,o-z)
12995 ! include 'DIMENSIONS'
12996 ! include 'COMMON.CHAIN'
12997 ! include 'COMMON.DERIV'
12998 ! include 'COMMON.CALC'
12999 ! include 'COMMON.IOUNITS'
13000 real(kind=8),dimension(3) :: dcosom1,dcosom2
13001 real(kind=8) :: scalfac
13002 !el local variables
13003 ! integer :: i,j,k,l
13005 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
13006 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
13007 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
13008 -2.0D0*alf12*eps3der+sigder*sigsq_om12
13012 ! eom12=evdwij*eps1_om12
13014 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
13015 ! & " sigder",sigder
13016 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
13017 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
13019 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
13020 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
13023 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac
13025 ! write (iout,*) "gg",(gg(k),k=1,3)
13027 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
13028 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
13029 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac
13030 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
13031 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
13032 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac
13033 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
13034 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
13035 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
13036 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
13039 ! Calculate the components of the gradient in DC and X
13042 gvdwc(l,i)=gvdwc(l,i)-gg(l)
13043 gvdwc(l,j)=gvdwc(l,j)+gg(l)
13046 end subroutine sc_grad_scale
13047 !-----------------------------------------------------------------------------
13048 ! energy_split-sep.F
13049 !-----------------------------------------------------------------------------
13050 subroutine etotal_long(energia)
13052 ! Compute the long-range slow-varying contributions to the energy
13054 ! implicit real*8 (a-h,o-z)
13055 ! include 'DIMENSIONS'
13056 use MD_data, only: totT
13060 !MS$ATTRIBUTES C :: proc_proc
13065 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
13067 ! include 'COMMON.SETUP'
13068 ! include 'COMMON.IOUNITS'
13069 ! include 'COMMON.FFIELD'
13070 ! include 'COMMON.DERIV'
13071 ! include 'COMMON.INTERACT'
13072 ! include 'COMMON.SBRIDGE'
13073 ! include 'COMMON.CHAIN'
13074 ! include 'COMMON.VAR'
13075 ! include 'COMMON.LOCAL'
13076 ! include 'COMMON.MD'
13077 real(kind=8),dimension(0:n_ene) :: energia
13078 !el local variables
13079 integer :: i,n_corr,n_corr1,ierror,ierr
13080 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
13081 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
13082 ecorr,ecorr5,ecorr6,eturn6,time00
13083 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
13084 !elwrite(iout,*)"in etotal long"
13086 if (modecalc.eq.12.or.modecalc.eq.14) then
13088 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
13090 call int_from_cart1(.false.)
13093 !elwrite(iout,*)"in etotal long"
13096 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
13097 ! & " absolute rank",myrank," nfgtasks",nfgtasks
13099 if (nfgtasks.gt.1) then
13101 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
13102 if (fg_rank.eq.0) then
13103 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
13104 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
13106 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
13107 ! FG slaves as WEIGHTS array.
13114 weights_(7)=wel_loc
13117 weights_(10)=wturn6
13119 weights_(12)=wscloc
13121 weights_(14)=wtor_d
13122 weights_(15)=wstrain
13123 weights_(16)=wvdwpp
13125 weights_(18)=scal14
13126 weights_(21)=wsccor
13127 ! FG Master broadcasts the WEIGHTS_ array
13128 call MPI_Bcast(weights_(1),n_ene,&
13129 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13131 ! FG slaves receive the WEIGHTS array
13132 call MPI_Bcast(weights(1),n_ene,&
13133 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13148 wstrain=weights(15)
13154 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
13156 time_Bcast=time_Bcast+MPI_Wtime()-time00
13157 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
13158 ! call chainbuild_cart
13159 ! call int_from_cart1(.false.)
13161 ! write (iout,*) 'Processor',myrank,
13162 ! & ' calling etotal_short ipot=',ipot
13164 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
13166 !d print *,'nnt=',nnt,' nct=',nct
13168 !elwrite(iout,*)"in etotal long"
13169 ! Compute the side-chain and electrostatic interaction energy
13171 goto (101,102,103,104,105,106) ipot
13172 ! Lennard-Jones potential.
13173 101 call elj_long(evdw)
13174 !d print '(a)','Exit ELJ'
13176 ! Lennard-Jones-Kihara potential (shifted).
13177 102 call eljk_long(evdw)
13179 ! Berne-Pechukas potential (dilated LJ, angular dependence).
13180 103 call ebp_long(evdw)
13182 ! Gay-Berne potential (shifted LJ, angular dependence).
13183 104 call egb_long(evdw)
13185 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
13186 105 call egbv_long(evdw)
13188 ! Soft-sphere potential
13189 106 call e_softsphere(evdw)
13191 ! Calculate electrostatic (H-bonding) energy of the main chain.
13195 if (ipot.lt.6) then
13197 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
13198 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
13199 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
13200 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
13202 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
13203 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
13204 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
13205 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
13207 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13216 ! write (iout,*) "Soft-spheer ELEC potential"
13217 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
13221 ! Calculate excluded-volume interaction energy between peptide groups
13224 if (ipot.lt.6) then
13225 if(wscp.gt.0d0) then
13226 call escp_long(evdw2,evdw2_14)
13232 call escp_soft_sphere(evdw2,evdw2_14)
13235 ! 12/1/95 Multi-body terms
13239 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
13240 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
13241 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
13242 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
13243 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
13250 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
13251 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
13254 ! If performing constraint dynamics, call the constraint energy
13255 ! after the equilibration time
13256 if(usampl.and.totT.gt.eq_time) then
13271 energia(2)=evdw2-evdw2_14
13272 energia(18)=evdw2_14
13281 energia(3)=ees+evdw1
13288 energia(8)=eello_turn3
13289 energia(9)=eello_turn4
13291 energia(20)=Uconst+Uconst_back
13292 call sum_energy(energia,.true.)
13293 ! write (iout,*) "Exit ETOTAL_LONG"
13296 end subroutine etotal_long
13297 !-----------------------------------------------------------------------------
13298 subroutine etotal_short(energia)
13300 ! Compute the short-range fast-varying contributions to the energy
13302 ! implicit real*8 (a-h,o-z)
13303 ! include 'DIMENSIONS'
13307 !MS$ATTRIBUTES C :: proc_proc
13312 integer :: ierror,ierr
13313 real(kind=8),dimension(n_ene) :: weights_
13314 real(kind=8) :: time00
13316 ! include 'COMMON.SETUP'
13317 ! include 'COMMON.IOUNITS'
13318 ! include 'COMMON.FFIELD'
13319 ! include 'COMMON.DERIV'
13320 ! include 'COMMON.INTERACT'
13321 ! include 'COMMON.SBRIDGE'
13322 ! include 'COMMON.CHAIN'
13323 ! include 'COMMON.VAR'
13324 ! include 'COMMON.LOCAL'
13325 real(kind=8),dimension(0:n_ene) :: energia
13326 !el local variables
13328 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
13329 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr
13332 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
13334 if (modecalc.eq.12.or.modecalc.eq.14) then
13336 if (fg_rank.eq.0) call int_from_cart1(.false.)
13338 call int_from_cart1(.false.)
13342 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
13343 ! & " absolute rank",myrank," nfgtasks",nfgtasks
13345 if (nfgtasks.gt.1) then
13347 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
13348 if (fg_rank.eq.0) then
13349 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
13350 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
13352 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
13353 ! FG slaves as WEIGHTS array.
13360 weights_(7)=wel_loc
13363 weights_(10)=wturn6
13365 weights_(12)=wscloc
13367 weights_(14)=wtor_d
13368 weights_(15)=wstrain
13369 weights_(16)=wvdwpp
13371 weights_(18)=scal14
13372 weights_(21)=wsccor
13373 ! FG Master broadcasts the WEIGHTS_ array
13374 call MPI_Bcast(weights_(1),n_ene,&
13375 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13377 ! FG slaves receive the WEIGHTS array
13378 call MPI_Bcast(weights(1),n_ene,&
13379 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13394 wstrain=weights(15)
13400 ! write (iout,*),"Processor",myrank," BROADCAST weights"
13401 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
13403 ! write (iout,*) "Processor",myrank," BROADCAST c"
13404 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
13406 ! write (iout,*) "Processor",myrank," BROADCAST dc"
13407 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
13409 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
13410 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
13412 ! write (iout,*) "Processor",myrank," BROADCAST theta"
13413 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
13415 ! write (iout,*) "Processor",myrank," BROADCAST phi"
13416 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
13418 ! write (iout,*) "Processor",myrank," BROADCAST alph"
13419 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
13421 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
13422 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
13424 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
13425 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
13427 time_Bcast=time_Bcast+MPI_Wtime()-time00
13428 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
13430 ! write (iout,*) 'Processor',myrank,
13431 ! & ' calling etotal_short ipot=',ipot
13433 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
13435 ! call int_from_cart1(.false.)
13437 ! Compute the side-chain and electrostatic interaction energy
13439 goto (101,102,103,104,105,106) ipot
13440 ! Lennard-Jones potential.
13441 101 call elj_short(evdw)
13442 !d print '(a)','Exit ELJ'
13444 ! Lennard-Jones-Kihara potential (shifted).
13445 102 call eljk_short(evdw)
13447 ! Berne-Pechukas potential (dilated LJ, angular dependence).
13448 103 call ebp_short(evdw)
13450 ! Gay-Berne potential (shifted LJ, angular dependence).
13451 104 call egb_short(evdw)
13453 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
13454 105 call egbv_short(evdw)
13456 ! Soft-sphere potential - already dealt with in the long-range part
13458 ! 106 call e_softsphere_short(evdw)
13460 ! Calculate electrostatic (H-bonding) energy of the main chain.
13464 ! Calculate the short-range part of Evdwpp
13466 call evdwpp_short(evdw1)
13468 ! Calculate the short-range part of ESCp
13470 if (ipot.lt.6) then
13471 call escp_short(evdw2,evdw2_14)
13474 ! Calculate the bond-stretching energy
13478 ! Calculate the disulfide-bridge and other energy and the contributions
13479 ! from other distance constraints.
13482 ! Calculate the virtual-bond-angle energy.
13486 ! Calculate the SC local energy.
13491 ! Calculate the virtual-bond torsional energy.
13493 call etor(etors,edihcnstr)
13495 ! 6/23/01 Calculate double-torsional energy
13497 call etor_d(etors_d)
13499 ! 21/5/07 Calculate local sicdechain correlation energy
13501 if (wsccor.gt.0.0d0) then
13502 call eback_sc_corr(esccor)
13507 ! Put energy components into an array
13514 energia(2)=evdw2-evdw2_14
13515 energia(18)=evdw2_14
13528 energia(14)=etors_d
13531 energia(19)=edihcnstr
13533 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
13535 call sum_energy(energia,.true.)
13536 ! write (iout,*) "Exit ETOTAL_SHORT"
13539 end subroutine etotal_short
13540 !-----------------------------------------------------------------------------
13542 !-----------------------------------------------------------------------------
13543 real(kind=8) function gnmr1(y,ymin,ymax)
13545 real(kind=8) :: y,ymin,ymax
13546 real(kind=8) :: wykl=4.0d0
13547 if (y.lt.ymin) then
13548 gnmr1=(ymin-y)**wykl/wykl
13549 else if (y.gt.ymax) then
13550 gnmr1=(y-ymax)**wykl/wykl
13556 !-----------------------------------------------------------------------------
13557 real(kind=8) function gnmr1prim(y,ymin,ymax)
13559 real(kind=8) :: y,ymin,ymax
13560 real(kind=8) :: wykl=4.0d0
13561 if (y.lt.ymin) then
13562 gnmr1prim=-(ymin-y)**(wykl-1)
13563 else if (y.gt.ymax) then
13564 gnmr1prim=(y-ymax)**(wykl-1)
13569 end function gnmr1prim
13570 !-----------------------------------------------------------------------------
13571 real(kind=8) function harmonic(y,ymax)
13573 real(kind=8) :: y,ymax
13574 real(kind=8) :: wykl=2.0d0
13575 harmonic=(y-ymax)**wykl
13577 end function harmonic
13578 !-----------------------------------------------------------------------------
13579 real(kind=8) function harmonicprim(y,ymax)
13580 real(kind=8) :: y,ymin,ymax
13581 real(kind=8) :: wykl=2.0d0
13582 harmonicprim=(y-ymax)*wykl
13584 end function harmonicprim
13585 !-----------------------------------------------------------------------------
13587 !-----------------------------------------------------------------------------
13588 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
13590 use io_base, only:intout,briefout
13591 ! implicit real*8 (a-h,o-z)
13592 ! include 'DIMENSIONS'
13593 ! include 'COMMON.CHAIN'
13594 ! include 'COMMON.DERIV'
13595 ! include 'COMMON.VAR'
13596 ! include 'COMMON.INTERACT'
13597 ! include 'COMMON.FFIELD'
13598 ! include 'COMMON.MD'
13599 ! include 'COMMON.IOUNITS'
13600 real(kind=8),external :: ufparm
13601 integer :: uiparm(1)
13602 real(kind=8) :: urparm(1)
13603 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
13604 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
13605 integer :: n,nf,ind,ind1,i,k,j
13607 ! This subroutine calculates total internal coordinate gradient.
13608 ! Depending on the number of function evaluations, either whole energy
13609 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
13610 ! internal coordinates are reevaluated or only the cartesian-in-internal
13611 ! coordinate derivatives are evaluated. The subroutine was designed to work
13617 !d print *,'grad',nf,icg
13618 if (nf-nfl+1) 20,30,40
13619 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
13620 ! write (iout,*) 'grad 20'
13621 if (nf.eq.0) return
13623 30 call var_to_geom(n,x)
13625 ! write (iout,*) 'grad 30'
13627 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
13630 ! write (iout,*) 'grad 40'
13631 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
13633 ! Convert the Cartesian gradient into internal-coordinate gradient.
13643 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
13645 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
13648 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
13654 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
13656 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
13657 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
13660 if (i.gt.1) g(i-1)=gphii
13661 if (n.gt.nphi) g(nphi+i)=gthetai
13663 if (n.le.nphi+ntheta) goto 10
13665 if (itype(i).ne.10) then
13669 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
13672 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
13674 g(ialph(i,1))=galphai
13675 g(ialph(i,1)+nside)=gomegai
13679 ! Add the components corresponding to local energy terms.
13683 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
13684 g(i)=g(i)+gloc(i,icg)
13686 ! Uncomment following three lines for diagnostics.
13688 !elwrite(iout,*) "in gradient after calling intout"
13689 !d call briefout(0,0.0d0)
13690 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
13692 end subroutine gradient
13693 !-----------------------------------------------------------------------------
13694 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
13697 ! implicit real*8 (a-h,o-z)
13698 ! include 'DIMENSIONS'
13699 ! include 'COMMON.DERIV'
13700 ! include 'COMMON.IOUNITS'
13701 ! include 'COMMON.GEO'
13704 !el common /chuju/ jjj
13705 real(kind=8) :: energia(0:n_ene)
13706 integer :: uiparm(1)
13707 real(kind=8) :: urparm(1)
13709 real(kind=8),external :: ufparm
13710 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
13711 ! if (jjj.gt.0) then
13712 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
13716 !d print *,'func',nf,nfl,icg
13717 call var_to_geom(n,x)
13720 !d write (iout,*) 'ETOTAL called from FUNC'
13721 call etotal(energia)
13724 ! if (jjj.gt.0) then
13725 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
13726 ! write (iout,*) 'f=',etot
13730 end subroutine func
13731 !-----------------------------------------------------------------------------
13732 subroutine cartgrad
13733 ! implicit real*8 (a-h,o-z)
13734 ! include 'DIMENSIONS'
13736 use MD_data, only: totT
13740 ! include 'COMMON.CHAIN'
13741 ! include 'COMMON.DERIV'
13742 ! include 'COMMON.VAR'
13743 ! include 'COMMON.INTERACT'
13744 ! include 'COMMON.FFIELD'
13745 ! include 'COMMON.MD'
13746 ! include 'COMMON.IOUNITS'
13747 ! include 'COMMON.TIME1'
13751 ! This subrouting calculates total Cartesian coordinate gradient.
13752 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
13762 !el write (iout,*) "After sum_gradient"
13764 !el write (iout,*) "After sum_gradient"
13766 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
13767 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
13770 ! If performing constraint dynamics, add the gradients of the constraint energy
13771 if(usampl.and.totT.gt.eq_time) then
13774 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
13775 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
13779 gloc(i,icg)=gloc(i,icg)+dugamma(i)
13782 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
13785 !elwrite (iout,*) "After sum_gradient"
13790 !elwrite (iout,*) "After sum_gradient"
13792 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
13794 ! call checkintcartgrad
13795 ! write(iout,*) 'calling int_to_cart'
13797 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
13801 gcart(j,i)=gradc(j,i,icg)
13802 gxcart(j,i)=gradx(j,i,icg)
13805 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
13806 (gxcart(j,i),j=1,3),gloc(i,icg)
13814 time_inttocart=time_inttocart+MPI_Wtime()-time01
13817 write (iout,*) "gcart and gxcart after int_to_cart"
13819 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
13820 (gxcart(j,i),j=1,3)
13824 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
13828 end subroutine cartgrad
13829 !-----------------------------------------------------------------------------
13830 subroutine zerograd
13831 ! implicit real*8 (a-h,o-z)
13832 ! include 'DIMENSIONS'
13833 ! include 'COMMON.DERIV'
13834 ! include 'COMMON.CHAIN'
13835 ! include 'COMMON.VAR'
13836 ! include 'COMMON.MD'
13837 ! include 'COMMON.SCCOR'
13839 !el local variables
13840 integer :: i,j,intertyp
13841 ! Initialize Cartesian-coordinate gradient
13843 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
13844 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
13846 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
13847 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
13848 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
13849 ! allocate(gradcorr_long(3,nres))
13850 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
13851 ! allocate(gcorr6_turn_long(3,nres))
13852 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
13854 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
13856 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
13857 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
13859 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
13860 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
13862 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
13863 ! allocate(gscloc(3,nres)) !(3,maxres)
13864 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
13868 ! common /deriv_scloc/
13869 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
13870 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
13871 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
13873 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
13877 ! gradc(j,i,icg)=0.0d0
13878 ! gradx(j,i,icg)=0.0d0
13880 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
13881 !elwrite(iout,*) "icg",icg
13885 gradx_scp(j,i)=0.0D0
13887 gvdwc_scp(j,i)=0.0D0
13888 gvdwc_scpp(j,i)=0.0d0
13890 gelc_long(j,i)=0.0D0
13895 gel_loc_long(j,i)=0.0d0
13898 gcorr3_turn(j,i)=0.0d0
13899 gcorr4_turn(j,i)=0.0d0
13900 gradcorr(j,i)=0.0d0
13901 gradcorr_long(j,i)=0.0d0
13902 gradcorr5_long(j,i)=0.0d0
13903 gradcorr6_long(j,i)=0.0d0
13904 gcorr6_turn_long(j,i)=0.0d0
13905 gradcorr5(j,i)=0.0d0
13906 gradcorr6(j,i)=0.0d0
13907 gcorr6_turn(j,i)=0.0d0
13910 gradc(j,i,icg)=0.0d0
13911 gradx(j,i,icg)=0.0d0
13915 gloc_sc(intertyp,i,icg)=0.0d0
13920 ! Initialize the gradient of local energy terms.
13922 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
13923 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
13924 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
13925 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
13926 ! allocate(gel_loc_turn3(nres))
13927 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
13928 ! allocate(gsccor_loc(nres)) !(maxres)
13934 gel_loc_loc(i)=0.0d0
13936 g_corr5_loc(i)=0.0d0
13937 g_corr6_loc(i)=0.0d0
13938 gel_loc_turn3(i)=0.0d0
13939 gel_loc_turn4(i)=0.0d0
13940 gel_loc_turn6(i)=0.0d0
13941 gsccor_loc(i)=0.0d0
13943 ! initialize gcart and gxcart
13944 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
13952 end subroutine zerograd
13953 !-----------------------------------------------------------------------------
13954 real(kind=8) function fdum()
13958 !-----------------------------------------------------------------------------
13960 !-----------------------------------------------------------------------------
13961 subroutine intcartderiv
13962 ! implicit real*8 (a-h,o-z)
13963 ! include 'DIMENSIONS'
13967 ! include 'COMMON.SETUP'
13968 ! include 'COMMON.CHAIN'
13969 ! include 'COMMON.VAR'
13970 ! include 'COMMON.GEO'
13971 ! include 'COMMON.INTERACT'
13972 ! include 'COMMON.DERIV'
13973 ! include 'COMMON.IOUNITS'
13974 ! include 'COMMON.LOCAL'
13975 ! include 'COMMON.SCCOR'
13976 real(kind=8) :: pi4,pi34
13977 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
13978 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
13979 dcosomega,dsinomega !(3,3,maxres)
13980 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
13983 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
13984 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
13985 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
13986 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
13990 !el from module energy-------------
13991 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
13992 !el allocate(dsintau(3,3,3,itau_start:itau_end))
13993 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
13995 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
13996 !el allocate(dsintau(3,3,3,0:nres2))
13997 !el allocate(dtauangle(3,3,3,0:nres2))
13998 !el allocate(domicron(3,2,2,0:nres2))
13999 !el allocate(dcosomicron(3,2,2,0:nres2))
14003 #if defined(MPI) && defined(PARINTDER)
14004 if (nfgtasks.gt.1 .and. me.eq.king) &
14005 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
14010 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
14011 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
14013 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
14016 dtheta(j,1,i)=0.0d0
14017 dtheta(j,2,i)=0.0d0
14023 ! Derivatives of theta's
14024 #if defined(MPI) && defined(PARINTDER)
14025 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
14026 do i=max0(ithet_start-1,3),ithet_end
14030 cost=dcos(theta(i))
14031 sint=sqrt(1-cost*cost)
14033 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
14035 if (itype(i-1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
14036 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
14038 if (itype(i-1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
14041 #if defined(MPI) && defined(PARINTDER)
14042 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
14043 do i=max0(ithet_start-1,3),ithet_end
14047 if ((itype(i-1).ne.10).and.(itype(i-1).ne.ntyp1)) then
14048 cost1=dcos(omicron(1,i))
14049 sint1=sqrt(1-cost1*cost1)
14050 cost2=dcos(omicron(2,i))
14051 sint2=sqrt(1-cost2*cost2)
14053 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
14054 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
14055 cost1*dc_norm(j,i-2))/ &
14057 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
14058 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
14059 +cost1*(dc_norm(j,i-1+nres)))/ &
14061 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
14062 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
14063 !C Looks messy but better than if in loop
14064 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
14065 +cost2*dc_norm(j,i-1))/ &
14067 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
14068 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
14069 +cost2*(-dc_norm(j,i-1+nres)))/ &
14071 ! write(iout,*) "vbld", i,itype(i),vbld(i-1+nres)
14072 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
14076 !elwrite(iout,*) "after vbld write"
14077 ! Derivatives of phi:
14078 ! If phi is 0 or 180 degrees, then the formulas
14079 ! have to be derived by power series expansion of the
14080 ! conventional formulas around 0 and 180.
14082 do i=iphi1_start,iphi1_end
14086 ! if (itype(i-1).eq.21 .or. itype(i-2).eq.21 ) cycle
14087 ! the conventional case
14088 sint=dsin(theta(i))
14089 sint1=dsin(theta(i-1))
14091 cost=dcos(theta(i))
14092 cost1=dcos(theta(i-1))
14094 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
14095 fac0=1.0d0/(sint1*sint)
14098 fac3=cosg*cost1/(sint1*sint1)
14099 fac4=cosg*cost/(sint*sint)
14100 ! Obtaining the gamma derivatives from sine derivative
14101 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
14102 phi(i).gt.pi34.and.phi(i).le.pi.or. &
14103 phi(i).gt.-pi.and.phi(i).le.-pi34) then
14104 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
14105 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
14106 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
14110 cosg_inv=1.0d0/cosg
14111 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
14112 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
14113 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
14114 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
14116 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
14117 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14118 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
14119 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
14120 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
14121 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14122 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
14124 ! Bug fixed 3/24/05 (AL)
14126 ! Obtaining the gamma derivatives from cosine derivative
14129 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
14130 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
14131 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
14132 dc_norm(j,i-3))/vbld(i-2)
14133 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
14134 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
14135 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
14137 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
14138 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
14139 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
14140 dc_norm(j,i-1))/vbld(i)
14141 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
14146 !alculate derivative of Tauangle
14148 do i=itau_start,itau_end
14151 !elwrite(iout,*) " vecpr",i,nres
14153 if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
14154 ! if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10).or.
14155 ! & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1)) cycle
14156 !c dtauangle(j,intertyp,dervityp,residue number)
14157 !c INTERTYP=1 SC...Ca...Ca..Ca
14158 ! the conventional case
14159 sint=dsin(theta(i))
14160 sint1=dsin(omicron(2,i-1))
14161 sing=dsin(tauangle(1,i))
14162 cost=dcos(theta(i))
14163 cost1=dcos(omicron(2,i-1))
14164 cosg=dcos(tauangle(1,i))
14165 !elwrite(iout,*) " vecpr5",i,nres
14167 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
14168 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
14169 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
14170 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
14172 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
14173 fac0=1.0d0/(sint1*sint)
14176 fac3=cosg*cost1/(sint1*sint1)
14177 fac4=cosg*cost/(sint*sint)
14178 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
14179 ! Obtaining the gamma derivatives from sine derivative
14180 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
14181 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
14182 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
14183 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
14184 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
14185 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
14189 cosg_inv=1.0d0/cosg
14190 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
14191 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
14192 *vbld_inv(i-2+nres)
14193 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
14194 dsintau(j,1,2,i)= &
14195 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
14196 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14197 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
14198 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
14199 ! Bug fixed 3/24/05 (AL)
14200 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
14201 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
14202 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14203 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
14205 ! Obtaining the gamma derivatives from cosine derivative
14208 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
14209 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
14210 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
14211 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
14212 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
14213 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
14215 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
14216 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
14217 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
14218 dc_norm(j,i-1))/vbld(i)
14219 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
14220 ! write (iout,*) "else",i
14224 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
14227 !C Second case Ca...Ca...Ca...SC
14229 do i=itau_start,itau_end
14233 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
14234 (itype(i-2).eq.ntyp1).or.(itype(i-3).eq.ntyp1)) cycle
14235 ! the conventional case
14236 sint=dsin(omicron(1,i))
14237 sint1=dsin(theta(i-1))
14238 sing=dsin(tauangle(2,i))
14239 cost=dcos(omicron(1,i))
14240 cost1=dcos(theta(i-1))
14241 cosg=dcos(tauangle(2,i))
14243 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
14245 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
14246 fac0=1.0d0/(sint1*sint)
14249 fac3=cosg*cost1/(sint1*sint1)
14250 fac4=cosg*cost/(sint*sint)
14251 ! Obtaining the gamma derivatives from sine derivative
14252 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
14253 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
14254 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
14255 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
14256 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
14257 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
14261 cosg_inv=1.0d0/cosg
14262 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
14263 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
14264 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
14265 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
14266 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
14267 dsintau(j,2,2,i)= &
14268 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
14269 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14270 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
14271 ! & sing*ctgt*domicron(j,1,2,i),
14272 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14273 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
14274 ! Bug fixed 3/24/05 (AL)
14275 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
14276 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
14277 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14278 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
14280 ! Obtaining the gamma derivatives from cosine derivative
14283 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
14284 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
14285 dc_norm(j,i-3))/vbld(i-2)
14286 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
14287 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
14288 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
14289 dcosomicron(j,1,1,i)
14290 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
14291 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
14292 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
14293 dc_norm(j,i-1+nres))/vbld(i-1+nres)
14294 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
14295 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
14300 !CC third case SC...Ca...Ca...SC
14303 do i=itau_start,itau_end
14307 ! the conventional case
14308 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
14309 (itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
14310 sint=dsin(omicron(1,i))
14311 sint1=dsin(omicron(2,i-1))
14312 sing=dsin(tauangle(3,i))
14313 cost=dcos(omicron(1,i))
14314 cost1=dcos(omicron(2,i-1))
14315 cosg=dcos(tauangle(3,i))
14317 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
14318 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
14320 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
14321 fac0=1.0d0/(sint1*sint)
14324 fac3=cosg*cost1/(sint1*sint1)
14325 fac4=cosg*cost/(sint*sint)
14326 ! Obtaining the gamma derivatives from sine derivative
14327 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
14328 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
14329 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
14330 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
14331 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
14332 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
14336 cosg_inv=1.0d0/cosg
14337 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
14338 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
14339 *vbld_inv(i-2+nres)
14340 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
14341 dsintau(j,3,2,i)= &
14342 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
14343 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14344 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
14345 ! Bug fixed 3/24/05 (AL)
14346 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
14347 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
14348 *vbld_inv(i-1+nres)
14349 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14350 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
14352 ! Obtaining the gamma derivatives from cosine derivative
14355 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
14356 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
14357 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
14358 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
14359 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
14360 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
14361 dcosomicron(j,1,1,i)
14362 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
14363 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
14364 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
14365 dc_norm(j,i-1+nres))/vbld(i-1+nres)
14366 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
14367 ! write(iout,*) "else",i
14373 ! Derivatives of side-chain angles alpha and omega
14374 #if defined(MPI) && defined(PARINTDER)
14375 do i=ibond_start,ibond_end
14379 if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then
14380 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
14383 fac8=fac5/vbld(i+1)
14384 fac9=fac5/vbld(i+nres)
14385 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
14386 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
14387 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
14388 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
14389 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
14390 sina=sqrt(1-cosa*cosa)
14392 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
14394 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
14395 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
14396 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
14397 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
14398 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
14399 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
14400 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
14401 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
14403 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
14405 ! obtaining the derivatives of omega from sines
14406 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
14407 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
14408 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
14409 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
14411 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
14412 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
14413 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
14414 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
14415 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
14416 coso_inv=1.0d0/dcos(omeg(i))
14418 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
14419 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
14420 (sino*dc_norm(j,i-1))/vbld(i)
14421 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
14422 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
14423 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
14424 -sino*dc_norm(j,i)/vbld(i+1)
14425 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
14426 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
14427 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
14429 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
14432 ! obtaining the derivatives of omega from cosines
14433 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
14434 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
14439 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
14440 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
14441 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
14442 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
14443 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
14444 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
14445 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
14446 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
14447 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
14448 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
14449 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
14450 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
14451 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
14452 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
14453 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
14459 dalpha(k,j,i)=0.0d0
14460 domega(k,j,i)=0.0d0
14466 #if defined(MPI) && defined(PARINTDER)
14467 if (nfgtasks.gt.1) then
14469 !d write (iout,*) "Gather dtheta"
14470 !d call flush(iout)
14471 write (iout,*) "dtheta before gather"
14473 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
14476 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
14477 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
14478 king,FG_COMM,IERROR)
14480 !d write (iout,*) "Gather dphi"
14481 !d call flush(iout)
14482 write (iout,*) "dphi before gather"
14484 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
14487 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
14488 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
14489 king,FG_COMM,IERROR)
14490 !d write (iout,*) "Gather dalpha"
14491 !d call flush(iout)
14493 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
14494 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
14495 king,FG_COMM,IERROR)
14496 !d write (iout,*) "Gather domega"
14497 !d call flush(iout)
14498 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
14499 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
14500 king,FG_COMM,IERROR)
14505 write (iout,*) "dtheta after gather"
14507 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
14509 write (iout,*) "dphi after gather"
14511 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
14513 write (iout,*) "dalpha after gather"
14515 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
14517 write (iout,*) "domega after gather"
14519 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
14523 end subroutine intcartderiv
14524 !-----------------------------------------------------------------------------
14525 subroutine checkintcartgrad
14526 ! implicit real*8 (a-h,o-z)
14527 ! include 'DIMENSIONS'
14531 ! include 'COMMON.CHAIN'
14532 ! include 'COMMON.VAR'
14533 ! include 'COMMON.GEO'
14534 ! include 'COMMON.INTERACT'
14535 ! include 'COMMON.DERIV'
14536 ! include 'COMMON.IOUNITS'
14537 ! include 'COMMON.SETUP'
14538 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
14539 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
14540 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
14541 real(kind=8),dimension(3) :: dc_norm_s
14542 real(kind=8) :: aincr=1.0d-5
14544 real(kind=8) :: dcji
14547 theta_s(i)=theta(i)
14551 ! Check theta gradient
14553 "Analytical (upper) and numerical (lower) gradient of theta"
14558 dc(j,i-2)=dcji+aincr
14559 call chainbuild_cart
14560 call int_from_cart1(.false.)
14561 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
14564 dc(j,i-1)=dc(j,i-1)+aincr
14565 call chainbuild_cart
14566 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
14569 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
14570 !el (dtheta(j,2,i),j=1,3)
14571 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
14572 !el (dthetanum(j,2,i),j=1,3)
14573 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
14574 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
14575 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
14578 ! Check gamma gradient
14580 "Analytical (upper) and numerical (lower) gradient of gamma"
14584 dc(j,i-3)=dcji+aincr
14585 call chainbuild_cart
14586 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
14589 dc(j,i-2)=dcji+aincr
14590 call chainbuild_cart
14591 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
14594 dc(j,i-1)=dc(j,i-1)+aincr
14595 call chainbuild_cart
14596 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
14599 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
14600 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
14601 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
14602 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
14603 !el write (iout,'(5x,3(3f10.5,5x))') &
14604 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
14605 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
14606 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
14609 ! Check alpha gradient
14611 "Analytical (upper) and numerical (lower) gradient of alpha"
14613 if(itype(i).ne.10) then
14616 dc(j,i-1)=dcji+aincr
14617 call chainbuild_cart
14618 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
14623 call chainbuild_cart
14624 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
14628 dc(j,i+nres)=dc(j,i+nres)+aincr
14629 call chainbuild_cart
14630 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
14635 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
14636 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
14637 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
14638 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
14639 !el write (iout,'(5x,3(3f10.5,5x))') &
14640 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
14641 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
14642 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
14645 ! Check omega gradient
14647 "Analytical (upper) and numerical (lower) gradient of omega"
14649 if(itype(i).ne.10) then
14652 dc(j,i-1)=dcji+aincr
14653 call chainbuild_cart
14654 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
14659 call chainbuild_cart
14660 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
14664 dc(j,i+nres)=dc(j,i+nres)+aincr
14665 call chainbuild_cart
14666 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
14671 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
14672 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
14673 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
14674 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
14675 !el write (iout,'(5x,3(3f10.5,5x))') &
14676 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
14677 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
14678 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
14682 end subroutine checkintcartgrad
14683 !-----------------------------------------------------------------------------
14685 !-----------------------------------------------------------------------------
14686 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
14687 ! implicit real*8 (a-h,o-z)
14688 ! include 'DIMENSIONS'
14689 ! include 'COMMON.IOUNITS'
14690 ! include 'COMMON.CHAIN'
14691 ! include 'COMMON.INTERACT'
14692 ! include 'COMMON.VAR'
14693 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
14694 integer :: kkk,nsep=3
14695 real(kind=8) :: qm !dist,
14696 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
14697 logical :: lprn=.false.
14699 ! real(kind=8) :: sigm,x
14701 !el sigm(x)=0.25d0*x ! local function
14707 do il=seg1+nsep,seg2
14710 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
14711 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
14712 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
14714 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
14715 if (itype(il).ne.10 .or. itype(jl).ne.10) then
14718 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
14719 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
14720 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
14721 dijCM=dist(il+nres,jl+nres)
14722 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
14724 qq = qq+qqij+qqijCM
14730 if((seg3-il).lt.3) then
14737 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
14738 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
14739 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
14741 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
14742 if (itype(il).ne.10 .or. itype(jl).ne.10) then
14745 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
14746 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
14747 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
14748 dijCM=dist(il+nres,jl+nres)
14749 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
14751 qq = qq+qqij+qqijCM
14756 if (qqmax.le.qq) qqmax=qq
14758 qwolynes=1.0d0-qqmax
14760 end function qwolynes
14761 !-----------------------------------------------------------------------------
14762 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
14763 ! implicit real*8 (a-h,o-z)
14764 ! include 'DIMENSIONS'
14765 ! include 'COMMON.IOUNITS'
14766 ! include 'COMMON.CHAIN'
14767 ! include 'COMMON.INTERACT'
14768 ! include 'COMMON.VAR'
14769 ! include 'COMMON.MD'
14770 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
14771 integer :: nsep=3, kkk
14772 !el real(kind=8) :: dist
14773 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
14774 logical :: lprn=.false.
14776 real(kind=8) :: sim,dd0,fac,ddqij
14777 !el sigm(x)=0.25d0*x ! local function
14787 do il=seg1+nsep,seg2
14790 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
14791 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
14792 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
14794 sim = 1.0d0/sigm(d0ij)
14797 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
14799 ddqij = (c(k,il)-c(k,jl))*fac
14800 dqwol(k,il)=dqwol(k,il)+ddqij
14801 dqwol(k,jl)=dqwol(k,jl)-ddqij
14804 if (itype(il).ne.10 .or. itype(jl).ne.10) then
14807 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
14808 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
14809 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
14810 dijCM=dist(il+nres,jl+nres)
14811 sim = 1.0d0/sigm(d0ijCM)
14814 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
14816 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
14817 dxqwol(k,il)=dxqwol(k,il)+ddqij
14818 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
14825 if((seg3-il).lt.3) then
14832 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
14833 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
14834 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
14836 sim = 1.0d0/sigm(d0ij)
14839 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
14841 ddqij = (c(k,il)-c(k,jl))*fac
14842 dqwol(k,il)=dqwol(k,il)+ddqij
14843 dqwol(k,jl)=dqwol(k,jl)-ddqij
14845 if (itype(il).ne.10 .or. itype(jl).ne.10) then
14848 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
14849 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
14850 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
14851 dijCM=dist(il+nres,jl+nres)
14852 sim = 1.0d0/sigm(d0ijCM)
14855 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
14857 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
14858 dxqwol(k,il)=dxqwol(k,il)+ddqij
14859 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
14868 dqwol(j,i)=dqwol(j,i)/nl
14869 dxqwol(j,i)=dxqwol(j,i)/nl
14873 end subroutine qwolynes_prim
14874 !-----------------------------------------------------------------------------
14875 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
14876 ! implicit real*8 (a-h,o-z)
14877 ! include 'DIMENSIONS'
14878 ! include 'COMMON.IOUNITS'
14879 ! include 'COMMON.CHAIN'
14880 ! include 'COMMON.INTERACT'
14881 ! include 'COMMON.VAR'
14882 integer :: seg1,seg2,seg3,seg4
14884 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
14885 real(kind=8),dimension(3,0:2*nres) :: cdummy
14886 real(kind=8) :: q1,q2
14887 real(kind=8) :: delta=1.0d-10
14892 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
14894 c(j,i)=c(j,i)+delta
14895 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
14896 qwolan(j,i)=(q2-q1)/delta
14902 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
14903 cdummy(j,i+nres)=c(j,i+nres)
14904 c(j,i+nres)=c(j,i+nres)+delta
14905 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
14906 qwolxan(j,i)=(q2-q1)/delta
14907 c(j,i+nres)=cdummy(j,i+nres)
14910 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
14912 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
14914 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
14916 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
14919 end subroutine qwol_num
14920 !-----------------------------------------------------------------------------
14921 subroutine EconstrQ
14922 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
14923 ! implicit real*8 (a-h,o-z)
14924 ! include 'DIMENSIONS'
14925 ! include 'COMMON.CONTROL'
14926 ! include 'COMMON.VAR'
14927 ! include 'COMMON.MD'
14930 ! include 'COMMON.LANGEVIN'
14932 ! include 'COMMON.LANGEVIN.lang0'
14934 ! include 'COMMON.CHAIN'
14935 ! include 'COMMON.DERIV'
14936 ! include 'COMMON.GEO'
14937 ! include 'COMMON.LOCAL'
14938 ! include 'COMMON.INTERACT'
14939 ! include 'COMMON.IOUNITS'
14940 ! include 'COMMON.NAMES'
14941 ! include 'COMMON.TIME1'
14942 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
14943 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
14945 integer :: kstart,kend,lstart,lend,idummy
14946 real(kind=8) :: delta=1.0d-7
14947 integer :: i,j,k,ii
14951 dudconst(j,i)=0.0d0
14952 duxconst(j,i)=0.0d0
14953 dudxconst(j,i)=0.0d0
14958 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
14960 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
14961 ! Calculating the derivatives of Constraint energy with respect to Q
14962 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
14964 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
14965 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
14966 ! hmnum=(hm2-hm1)/delta
14967 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
14968 ! & qinfrag(i,iset))
14969 ! write(iout,*) "harmonicnum frag", hmnum
14970 ! Calculating the derivatives of Q with respect to cartesian coordinates
14971 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
14973 ! write(iout,*) "dqwol "
14975 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
14977 ! write(iout,*) "dxqwol "
14979 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
14981 ! Calculating numerical gradients of dU/dQi and dQi/dxi
14982 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
14983 ! & ,idummy,idummy)
14984 ! The gradients of Uconst in Cs
14987 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
14988 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
14993 kstart=ifrag(1,ipair(1,i,iset),iset)
14994 kend=ifrag(2,ipair(1,i,iset),iset)
14995 lstart=ifrag(1,ipair(2,i,iset),iset)
14996 lend=ifrag(2,ipair(2,i,iset),iset)
14997 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
14998 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
14999 ! Calculating dU/dQ
15000 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
15001 ! hm1=harmonic(qpair(i),qinpair(i,iset))
15002 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
15003 ! hmnum=(hm2-hm1)/delta
15004 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
15005 ! & qinpair(i,iset))
15006 ! write(iout,*) "harmonicnum pair ", hmnum
15007 ! Calculating dQ/dXi
15008 call qwolynes_prim(kstart,kend,.false.,&
15010 ! write(iout,*) "dqwol "
15012 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
15014 ! write(iout,*) "dxqwol "
15016 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
15018 ! Calculating numerical gradients
15019 ! call qwol_num(kstart,kend,.false.
15021 ! The gradients of Uconst in Cs
15024 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
15025 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
15029 ! write(iout,*) "Uconst inside subroutine ", Uconst
15030 ! Transforming the gradients from Cs to dCs for the backbone
15034 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
15038 ! Transforming the gradients from Cs to dCs for the side chains
15041 dudxconst(j,i)=duxconst(j,i)
15044 ! write(iout,*) "dU/ddc backbone "
15046 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
15048 ! write(iout,*) "dU/ddX side chain "
15050 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
15052 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
15053 ! call dEconstrQ_num
15055 end subroutine EconstrQ
15056 !-----------------------------------------------------------------------------
15057 subroutine dEconstrQ_num
15058 ! Calculating numerical dUconst/ddc and dUconst/ddx
15059 ! implicit real*8 (a-h,o-z)
15060 ! include 'DIMENSIONS'
15061 ! include 'COMMON.CONTROL'
15062 ! include 'COMMON.VAR'
15063 ! include 'COMMON.MD'
15066 ! include 'COMMON.LANGEVIN'
15068 ! include 'COMMON.LANGEVIN.lang0'
15070 ! include 'COMMON.CHAIN'
15071 ! include 'COMMON.DERIV'
15072 ! include 'COMMON.GEO'
15073 ! include 'COMMON.LOCAL'
15074 ! include 'COMMON.INTERACT'
15075 ! include 'COMMON.IOUNITS'
15076 ! include 'COMMON.NAMES'
15077 ! include 'COMMON.TIME1'
15078 real(kind=8) :: uzap1,uzap2
15079 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
15080 integer :: kstart,kend,lstart,lend,idummy
15081 real(kind=8) :: delta=1.0d-7
15082 !el local variables
15088 dUcartan(j,i)=0.0d0
15089 cdummy(j,i)=dc(j,i)
15090 dc(j,i)=dc(j,i)+delta
15091 call chainbuild_cart
15094 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15096 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
15100 kstart=ifrag(1,ipair(1,ii,iset),iset)
15101 kend=ifrag(2,ipair(1,ii,iset),iset)
15102 lstart=ifrag(1,ipair(2,ii,iset),iset)
15103 lend=ifrag(2,ipair(2,ii,iset),iset)
15104 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15105 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
15108 dc(j,i)=cdummy(j,i)
15109 call chainbuild_cart
15112 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15114 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
15118 kstart=ifrag(1,ipair(1,ii,iset),iset)
15119 kend=ifrag(2,ipair(1,ii,iset),iset)
15120 lstart=ifrag(1,ipair(2,ii,iset),iset)
15121 lend=ifrag(2,ipair(2,ii,iset),iset)
15122 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15123 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
15126 ducartan(j,i)=(uzap2-uzap1)/(delta)
15129 ! Calculating numerical gradients for dU/ddx
15131 duxcartan(j,i)=0.0d0
15133 cdummy(j,i)=dc(j,i+nres)
15134 dc(j,i+nres)=dc(j,i+nres)+delta
15135 call chainbuild_cart
15138 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15140 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
15144 kstart=ifrag(1,ipair(1,ii,iset),iset)
15145 kend=ifrag(2,ipair(1,ii,iset),iset)
15146 lstart=ifrag(1,ipair(2,ii,iset),iset)
15147 lend=ifrag(2,ipair(2,ii,iset),iset)
15148 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15149 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
15152 dc(j,i+nres)=cdummy(j,i)
15153 call chainbuild_cart
15156 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
15157 ifrag(2,ii,iset),.true.,idummy,idummy)
15158 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
15162 kstart=ifrag(1,ipair(1,ii,iset),iset)
15163 kend=ifrag(2,ipair(1,ii,iset),iset)
15164 lstart=ifrag(1,ipair(2,ii,iset),iset)
15165 lend=ifrag(2,ipair(2,ii,iset),iset)
15166 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15167 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
15170 duxcartan(j,i)=(uzap2-uzap1)/(delta)
15173 write(iout,*) "Numerical dUconst/ddc backbone "
15175 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
15177 ! write(iout,*) "Numerical dUconst/ddx side-chain "
15179 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
15182 end subroutine dEconstrQ_num
15183 !-----------------------------------------------------------------------------
15185 !-----------------------------------------------------------------------------
15186 subroutine check_energies
15188 ! use random, only: ran_number
15192 ! include 'DIMENSIONS'
15193 ! include 'COMMON.CHAIN'
15194 ! include 'COMMON.VAR'
15195 ! include 'COMMON.IOUNITS'
15196 ! include 'COMMON.SBRIDGE'
15197 ! include 'COMMON.LOCAL'
15198 ! include 'COMMON.GEO'
15200 ! External functions
15201 !EL double precision ran_number
15202 !EL external ran_number
15205 integer :: i,j,k,l,lmax,p,pmax
15206 real(kind=8) :: rmin,rmax
15207 real(kind=8) :: eij
15210 real(kind=8) :: wi,rij,tj,pj
15232 !t wi=ran_number(0.0D0,pi)
15233 ! wi=ran_number(0.0D0,pi/6.0D0)
15235 !t tj=ran_number(0.0D0,pi)
15236 !t pj=ran_number(0.0D0,pi)
15237 ! pj=ran_number(0.0D0,pi/6.0D0)
15241 !t rij=ran_number(rmin,rmax)
15243 c(1,j)=d*sin(pj)*cos(tj)
15244 c(2,j)=d*sin(pj)*sin(tj)
15250 c(3,i)=-rij-d*cos(wi)
15253 dc(k,nres+i)=c(k,nres+i)-c(k,i)
15254 dc_norm(k,nres+i)=dc(k,nres+i)/d
15255 dc(k,nres+j)=c(k,nres+j)-c(k,j)
15256 dc_norm(k,nres+j)=dc(k,nres+j)/d
15259 call dyn_ssbond_ene(i,j,eij)
15264 end subroutine check_energies
15265 !-----------------------------------------------------------------------------
15266 subroutine dyn_ssbond_ene(resi,resj,eij)
15271 ! include 'DIMENSIONS'
15272 ! include 'COMMON.SBRIDGE'
15273 ! include 'COMMON.CHAIN'
15274 ! include 'COMMON.DERIV'
15275 ! include 'COMMON.LOCAL'
15276 ! include 'COMMON.INTERACT'
15277 ! include 'COMMON.VAR'
15278 ! include 'COMMON.IOUNITS'
15279 ! include 'COMMON.CALC'
15283 ! include 'COMMON.MD'
15284 ! use MD, only: totT,t_bath
15287 ! External functions
15288 !EL double precision h_base
15289 !EL external h_base
15292 integer :: resi,resj
15295 real(kind=8) :: eij
15298 logical :: havebond
15299 integer itypi,itypj
15300 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
15301 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
15302 real(kind=8),dimension(3) :: dcosom1,dcosom2
15304 real(kind=8) :: pom1,pom2
15305 real(kind=8) :: ljA,ljB,ljXs
15306 real(kind=8),dimension(1:3) :: d_ljB
15307 real(kind=8) :: ssA,ssB,ssC,ssXs
15308 real(kind=8) :: ssxm,ljxm,ssm,ljm
15309 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
15310 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
15311 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
15312 !-------FIRST METHOD
15314 real(kind=8),dimension(1:3) :: d_xm
15315 !-------END FIRST METHOD
15316 !-------SECOND METHOD
15317 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
15318 !-------END SECOND METHOD
15320 !-------TESTING CODE
15321 !el logical :: checkstop,transgrad
15322 !el common /sschecks/ checkstop,transgrad
15324 integer :: icheck,nicheck,jcheck,njcheck
15325 real(kind=8),dimension(-1:1) :: echeck
15326 real(kind=8) :: deps,ssx0,ljx0
15327 !-------END TESTING CODE
15333 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
15334 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
15337 dxi=dc_norm(1,nres+i)
15338 dyi=dc_norm(2,nres+i)
15339 dzi=dc_norm(3,nres+i)
15340 dsci_inv=vbld_inv(i+nres)
15343 xj=c(1,nres+j)-c(1,nres+i)
15344 yj=c(2,nres+j)-c(2,nres+i)
15345 zj=c(3,nres+j)-c(3,nres+i)
15346 dxj=dc_norm(1,nres+j)
15347 dyj=dc_norm(2,nres+j)
15348 dzj=dc_norm(3,nres+j)
15349 dscj_inv=vbld_inv(j+nres)
15351 chi1=chi(itypi,itypj)
15352 chi2=chi(itypj,itypi)
15359 alf12=0.5D0*(alf1+alf2)
15361 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15362 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
15363 ! The following are set in sc_angular
15367 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
15368 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
15369 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
15371 rij=1.0D0/rij ! Reset this so it makes sense
15373 sig0ij=sigma(itypi,itypj)
15374 sig=sig0ij*dsqrt(1.0D0/sigsq)
15377 ljA=eps1*eps2rt**2*eps3rt**2
15378 ljB=ljA*bb(itypi,itypj)
15379 ljA=ljA*aa(itypi,itypj)
15380 ljxm=ljXs+(-2.0D0*aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
15385 deltat12=om2-om1+2.0d0
15386 cosphi=om12-om1*om2
15390 +akth*(deltat1*deltat1+deltat2*deltat2) &
15391 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
15392 ssxm=ssXs-0.5D0*ssB/ssA
15394 !-------TESTING CODE
15395 !$$$c Some extra output
15396 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
15397 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
15398 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
15399 !$$$ if (ssx0.gt.0.0d0) then
15400 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
15404 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
15405 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
15406 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
15408 !-------END TESTING CODE
15410 !-------TESTING CODE
15411 ! Stop and plot energy and derivative as a function of distance
15412 if (checkstop) then
15413 ssm=ssC-0.25D0*ssB*ssB/ssA
15414 ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
15415 if (ssm.lt.ljm .and. &
15416 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
15424 if (.not.checkstop) then
15429 do icheck=0,nicheck
15430 do jcheck=-1,njcheck
15431 if (checkstop) rij=(ssxm-1.0d0)+ &
15432 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
15433 !-------END TESTING CODE
15435 if (rij.gt.ljxm) then
15438 fac=(1.0D0/ljd)**expon
15439 e1=fac*fac*aa(itypi,itypj)
15440 e2=fac*bb(itypi,itypj)
15441 eij=eps1*eps2rt*eps3rt*(e1+e2)
15444 eij=eij*eps2rt*eps3rt
15447 e1=e1*eps1*eps2rt**2*eps3rt**2
15448 ed=-expon*(e1+eij)/ljd
15450 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
15451 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
15452 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
15453 -2.0D0*alf12*eps3der+sigder*sigsq_om12
15454 else if (rij.lt.ssxm) then
15457 eij=ssA*ssd*ssd+ssB*ssd+ssC
15459 ed=2*akcm*ssd+akct*deltat12
15461 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
15462 eom1=-2*akth*deltat1-pom1-om2*pom2
15463 eom2= 2*akth*deltat2+pom1-om1*pom2
15466 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
15468 d_ssxm(1)=0.5D0*akct/ssA
15469 d_ssxm(2)=-d_ssxm(1)
15472 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
15473 d_ljxm(2)=d_ljxm(1)*sigsq_om2
15474 d_ljxm(3)=d_ljxm(1)*sigsq_om12
15475 d_ljxm(1)=d_ljxm(1)*sigsq_om1
15477 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
15478 xm=0.5d0*(ssxm+ljxm)
15480 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
15482 if (rij.lt.xm) then
15484 ssm=ssC-0.25D0*ssB*ssB/ssA
15485 d_ssm(1)=0.5D0*akct*ssB/ssA
15486 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
15487 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
15489 f1=(rij-xm)/(ssxm-xm)
15490 f2=(rij-ssxm)/(xm-ssxm)
15494 delta_inv=1.0d0/(xm-ssxm)
15495 deltasq_inv=delta_inv*delta_inv
15497 fac1=deltasq_inv*fac*(xm-rij)
15498 fac2=deltasq_inv*fac*(rij-ssxm)
15499 ed=delta_inv*(Ht*hd2-ssm*hd1)
15500 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
15501 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
15502 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
15505 ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
15506 d_ljm(1)=-0.5D0*bb(itypi,itypj)/aa(itypi,itypj)*ljB
15507 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
15508 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
15510 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
15511 f1=(rij-ljxm)/(xm-ljxm)
15512 f2=(rij-xm)/(ljxm-xm)
15516 delta_inv=1.0d0/(ljxm-xm)
15517 deltasq_inv=delta_inv*delta_inv
15519 fac1=deltasq_inv*fac*(ljxm-rij)
15520 fac2=deltasq_inv*fac*(rij-xm)
15521 ed=delta_inv*(ljm*hd2-Ht*hd1)
15522 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
15523 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
15524 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
15526 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
15528 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
15534 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
15535 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
15536 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
15538 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
15539 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
15540 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
15541 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
15542 !$$$ d_ssm(3)=omega
15544 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
15546 !$$$ d_ljm(k)=ljm*d_ljB(k)
15550 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
15551 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
15552 !$$$ d_ss(2)=akct*ssd
15553 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
15554 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
15557 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
15558 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
15559 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
15561 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
15562 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
15564 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
15566 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
15567 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
15568 !$$$ h1=h_base(f1,hd1)
15569 !$$$ h2=h_base(f2,hd2)
15570 !$$$ eij=ss*h1+ljf*h2
15571 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
15572 !$$$ deltasq_inv=delta_inv*delta_inv
15573 !$$$ fac=ljf*hd2-ss*hd1
15574 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
15575 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
15576 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
15577 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
15578 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
15579 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
15580 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
15582 !$$$ havebond=.false.
15583 !$$$ if (ed.gt.0.0d0) havebond=.true.
15584 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
15591 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
15592 ! write(iout,'(a15,f12.2,f8.1,2i5)')
15593 ! & "SSBOND_E_FORM",totT,t_bath,i,j
15597 dyn_ssbond_ij(i,j)=eij
15598 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
15599 dyn_ssbond_ij(i,j)=1.0d300
15602 ! write(iout,'(a15,f12.2,f8.1,2i5)')
15603 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
15608 !-------TESTING CODE
15609 !el if (checkstop) then
15610 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
15611 "CHECKSTOP",rij,eij,ed
15615 if (checkstop) then
15616 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
15619 if (checkstop) then
15623 !-------END TESTING CODE
15626 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
15627 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
15630 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
15633 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
15634 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
15635 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
15636 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
15637 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
15638 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
15642 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
15647 gvdwc(l,i)=gvdwc(l,i)-gg(l)
15648 gvdwc(l,j)=gvdwc(l,j)+gg(l)
15652 end subroutine dyn_ssbond_ene
15653 !-----------------------------------------------------------------------------
15654 real(kind=8) function h_base(x,deriv)
15655 ! A smooth function going 0->1 in range [0,1]
15656 ! It should NOT be called outside range [0,1], it will not work there.
15663 real(kind=8) :: deriv
15666 real(kind=8) :: xsq
15669 ! Two parabolas put together. First derivative zero at extrema
15670 !$$$ if (x.lt.0.5D0) then
15671 !$$$ h_base=2.0D0*x*x
15675 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
15676 !$$$ deriv=4.0D0*deriv
15679 ! Third degree polynomial. First derivative zero at extrema
15680 h_base=x*x*(3.0d0-2.0d0*x)
15681 deriv=6.0d0*x*(1.0d0-x)
15683 ! Fifth degree polynomial. First and second derivatives zero at extrema
15685 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
15687 !$$$ deriv=deriv*deriv
15688 !$$$ deriv=30.0d0*xsq*deriv
15691 end function h_base
15692 !-----------------------------------------------------------------------------
15693 subroutine dyn_set_nss
15694 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
15696 use MD_data, only: totT,t_bath
15698 ! include 'DIMENSIONS'
15702 ! include 'COMMON.SBRIDGE'
15703 ! include 'COMMON.CHAIN'
15704 ! include 'COMMON.IOUNITS'
15705 ! include 'COMMON.SETUP'
15706 ! include 'COMMON.MD'
15708 real(kind=8) :: emin
15709 integer :: i,j,imin,ierr
15710 integer :: diff,allnss,newnss
15711 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
15714 integer,dimension(0:nfgtasks) :: i_newnss
15715 integer,dimension(0:nfgtasks) :: displ
15716 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
15717 integer :: g_newnss
15722 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
15731 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
15735 if (allflag(i).eq.0 .and. &
15736 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
15737 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
15741 if (emin.lt.1.0d300) then
15744 if (allflag(i).eq.0 .and. &
15745 (allihpb(i).eq.allihpb(imin) .or. &
15746 alljhpb(i).eq.allihpb(imin) .or. &
15747 allihpb(i).eq.alljhpb(imin) .or. &
15748 alljhpb(i).eq.alljhpb(imin))) then
15755 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
15759 if (allflag(i).eq.1) then
15761 newihpb(newnss)=allihpb(i)
15762 newjhpb(newnss)=alljhpb(i)
15767 if (nfgtasks.gt.1)then
15769 call MPI_Reduce(newnss,g_newnss,1,&
15770 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
15771 call MPI_Gather(newnss,1,MPI_INTEGER,&
15772 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
15774 do i=1,nfgtasks-1,1
15775 displ(i)=i_newnss(i-1)+displ(i-1)
15777 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
15778 g_newihpb,i_newnss,displ,MPI_INTEGER,&
15780 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
15781 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
15783 if(fg_rank.eq.0) then
15784 ! print *,'g_newnss',g_newnss
15785 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
15786 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
15789 newihpb(i)=g_newihpb(i)
15790 newjhpb(i)=g_newjhpb(i)
15798 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
15803 if (idssb(i).eq.newihpb(j) .and. &
15804 jdssb(i).eq.newjhpb(j)) found=.true.
15808 if (.not.found.and.fg_rank.eq.0) &
15809 write(iout,'(a15,f12.2,f8.1,2i5)') &
15810 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
15818 if (newihpb(i).eq.idssb(j) .and. &
15819 newjhpb(i).eq.jdssb(j)) found=.true.
15823 if (.not.found.and.fg_rank.eq.0) &
15824 write(iout,'(a15,f12.2,f8.1,2i5)') &
15825 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
15832 idssb(i)=newihpb(i)
15833 jdssb(i)=newjhpb(i)
15837 end subroutine dyn_set_nss
15838 !-----------------------------------------------------------------------------
15840 subroutine read_ssHist
15843 ! include 'DIMENSIONS'
15844 ! include "DIMENSIONS.FREE"
15845 ! include 'COMMON.FREE'
15848 character(len=80) :: controlcard
15851 call card_concat(controlcard,.true.)
15852 read(controlcard,*) &
15853 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
15857 end subroutine read_ssHist
15859 !-----------------------------------------------------------------------------
15860 integer function indmat(i,j)
15862 ! get the position of the jth ijth fragment of the chain coordinate system
15863 ! in the fromto array.
15866 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
15868 end function indmat
15869 !-----------------------------------------------------------------------------
15870 real(kind=8) function sigm(x)
15876 !-----------------------------------------------------------------------------
15877 !-----------------------------------------------------------------------------
15878 subroutine alloc_ener_arrays
15879 !EL Allocation of arrays used by module energy
15881 !el local variables
15884 if(nres.lt.100) then
15886 elseif(nres.lt.200) then
15887 maxconts=0.8*nres ! Max. number of contacts per residue
15889 maxconts=0.6*nres ! (maxconts=maxres/4)
15891 maxcont=12*nres ! Max. number of SC contacts
15892 maxvar=6*nres ! Max. number of variables
15893 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
15894 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
15895 !----------------------
15896 ! arrays in subroutine init_int_table
15898 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
15899 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
15901 allocate(nint_gr(nres))
15902 allocate(nscp_gr(nres))
15903 allocate(ielstart(nres))
15904 allocate(ielend(nres))
15906 allocate(istart(nres,maxint_gr))
15907 allocate(iend(nres,maxint_gr))
15908 !(maxres,maxint_gr)
15909 allocate(iscpstart(nres,maxint_gr))
15910 allocate(iscpend(nres,maxint_gr))
15911 !(maxres,maxint_gr)
15912 allocate(ielstart_vdw(nres))
15913 allocate(ielend_vdw(nres))
15916 allocate(lentyp(0:nfgtasks-1))
15918 !----------------------
15920 ! common /contacts/
15921 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
15922 allocate(icont(2,maxcont))
15924 ! common /contacts1/
15925 allocate(num_cont(0:nres+4))
15927 allocate(jcont(maxconts,nres))
15929 allocate(facont(maxconts,nres))
15931 allocate(gacont(3,maxconts,nres))
15932 !(3,maxconts,maxres)
15933 ! common /contacts_hb/
15934 allocate(gacontp_hb1(3,maxconts,nres))
15935 allocate(gacontp_hb2(3,maxconts,nres))
15936 allocate(gacontp_hb3(3,maxconts,nres))
15937 allocate(gacontm_hb1(3,maxconts,nres))
15938 allocate(gacontm_hb2(3,maxconts,nres))
15939 allocate(gacontm_hb3(3,maxconts,nres))
15940 allocate(gacont_hbr(3,maxconts,nres))
15941 allocate(grij_hb_cont(3,maxconts,nres))
15942 !(3,maxconts,maxres)
15943 allocate(facont_hb(maxconts,nres))
15944 allocate(ees0p(maxconts,nres))
15945 allocate(ees0m(maxconts,nres))
15946 allocate(d_cont(maxconts,nres))
15948 allocate(num_cont_hb(nres))
15950 allocate(jcont_hb(maxconts,nres))
15953 allocate(Ug(2,2,nres))
15954 allocate(Ugder(2,2,nres))
15955 allocate(Ug2(2,2,nres))
15956 allocate(Ug2der(2,2,nres))
15958 allocate(obrot(2,nres))
15959 allocate(obrot2(2,nres))
15960 allocate(obrot_der(2,nres))
15961 allocate(obrot2_der(2,nres))
15963 ! common /precomp1/
15964 allocate(mu(2,nres))
15965 allocate(muder(2,nres))
15966 allocate(Ub2(2,nres))
15971 allocate(Ub2der(2,nres))
15972 allocate(Ctobr(2,nres))
15973 allocate(Ctobrder(2,nres))
15974 allocate(Dtobr2(2,nres))
15975 allocate(Dtobr2der(2,nres))
15977 allocate(EUg(2,2,nres))
15978 allocate(EUgder(2,2,nres))
15979 allocate(CUg(2,2,nres))
15980 allocate(CUgder(2,2,nres))
15981 allocate(DUg(2,2,nres))
15982 allocate(Dugder(2,2,nres))
15983 allocate(DtUg2(2,2,nres))
15984 allocate(DtUg2der(2,2,nres))
15986 ! common /precomp2/
15987 allocate(Ug2Db1t(2,nres))
15988 allocate(Ug2Db1tder(2,nres))
15989 allocate(CUgb2(2,nres))
15990 allocate(CUgb2der(2,nres))
15992 allocate(EUgC(2,2,nres))
15993 allocate(EUgCder(2,2,nres))
15994 allocate(EUgD(2,2,nres))
15995 allocate(EUgDder(2,2,nres))
15996 allocate(DtUg2EUg(2,2,nres))
15997 allocate(Ug2DtEUg(2,2,nres))
15999 allocate(Ug2DtEUgder(2,2,2,nres))
16000 allocate(DtUg2EUgder(2,2,2,nres))
16002 ! common /rotat_old/
16003 allocate(costab(nres))
16004 allocate(sintab(nres))
16005 allocate(costab2(nres))
16006 allocate(sintab2(nres))
16009 allocate(a_chuj(2,2,maxconts,nres))
16010 !(2,2,maxconts,maxres)(maxconts=maxres/4)
16011 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
16012 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
16013 ! common /contdistrib/
16014 allocate(ncont_sent(nres))
16015 allocate(ncont_recv(nres))
16017 allocate(iat_sent(nres))
16019 allocate(iint_sent(4,nres,nres))
16020 allocate(iint_sent_local(4,nres,nres))
16022 allocate(iturn3_sent(4,0:nres+4))
16023 allocate(iturn4_sent(4,0:nres+4))
16024 allocate(iturn3_sent_local(4,nres))
16025 allocate(iturn4_sent_local(4,nres))
16027 allocate(itask_cont_from(0:nfgtasks-1))
16028 allocate(itask_cont_to(0:nfgtasks-1))
16029 !(0:max_fg_procs-1)
16033 !----------------------
16036 allocate(dcdv(6,maxdim))
16037 allocate(dxdv(6,maxdim))
16039 allocate(dxds(6,nres))
16041 allocate(gradx(3,nres,0:2))
16042 allocate(gradc(3,nres,0:2))
16044 allocate(gvdwx(3,nres))
16045 allocate(gvdwc(3,nres))
16046 allocate(gelc(3,nres))
16047 allocate(gelc_long(3,nres))
16048 allocate(gvdwpp(3,nres))
16049 allocate(gvdwc_scpp(3,nres))
16050 allocate(gradx_scp(3,nres))
16051 allocate(gvdwc_scp(3,nres))
16052 allocate(ghpbx(3,nres))
16053 allocate(ghpbc(3,nres))
16054 allocate(gradcorr(3,nres))
16055 allocate(gradcorr_long(3,nres))
16056 allocate(gradcorr5_long(3,nres))
16057 allocate(gradcorr6_long(3,nres))
16058 allocate(gcorr6_turn_long(3,nres))
16059 allocate(gradxorr(3,nres))
16060 allocate(gradcorr5(3,nres))
16061 allocate(gradcorr6(3,nres))
16063 allocate(gloc(0:maxvar,0:2))
16064 allocate(gloc_x(0:maxvar,2))
16066 allocate(gel_loc(3,nres))
16067 allocate(gel_loc_long(3,nres))
16068 allocate(gcorr3_turn(3,nres))
16069 allocate(gcorr4_turn(3,nres))
16070 allocate(gcorr6_turn(3,nres))
16071 allocate(gradb(3,nres))
16072 allocate(gradbx(3,nres))
16074 allocate(gel_loc_loc(maxvar))
16075 allocate(gel_loc_turn3(maxvar))
16076 allocate(gel_loc_turn4(maxvar))
16077 allocate(gel_loc_turn6(maxvar))
16078 allocate(gcorr_loc(maxvar))
16079 allocate(g_corr5_loc(maxvar))
16080 allocate(g_corr6_loc(maxvar))
16082 allocate(gsccorc(3,nres))
16083 allocate(gsccorx(3,nres))
16085 allocate(gsccor_loc(nres))
16087 allocate(dtheta(3,2,nres))
16089 allocate(gscloc(3,nres))
16090 allocate(gsclocx(3,nres))
16092 allocate(dphi(3,3,nres))
16093 allocate(dalpha(3,3,nres))
16094 allocate(domega(3,3,nres))
16096 ! common /deriv_scloc/
16097 allocate(dXX_C1tab(3,nres))
16098 allocate(dYY_C1tab(3,nres))
16099 allocate(dZZ_C1tab(3,nres))
16100 allocate(dXX_Ctab(3,nres))
16101 allocate(dYY_Ctab(3,nres))
16102 allocate(dZZ_Ctab(3,nres))
16103 allocate(dXX_XYZtab(3,nres))
16104 allocate(dYY_XYZtab(3,nres))
16105 allocate(dZZ_XYZtab(3,nres))
16108 allocate(jgrad_start(nres))
16109 allocate(jgrad_end(nres))
16111 !----------------------
16114 allocate(ibond_displ(0:nfgtasks-1))
16115 allocate(ibond_count(0:nfgtasks-1))
16116 allocate(ithet_displ(0:nfgtasks-1))
16117 allocate(ithet_count(0:nfgtasks-1))
16118 allocate(iphi_displ(0:nfgtasks-1))
16119 allocate(iphi_count(0:nfgtasks-1))
16120 allocate(iphi1_displ(0:nfgtasks-1))
16121 allocate(iphi1_count(0:nfgtasks-1))
16122 allocate(ivec_displ(0:nfgtasks-1))
16123 allocate(ivec_count(0:nfgtasks-1))
16124 allocate(iset_displ(0:nfgtasks-1))
16125 allocate(iset_count(0:nfgtasks-1))
16126 allocate(iint_count(0:nfgtasks-1))
16127 allocate(iint_displ(0:nfgtasks-1))
16128 !(0:max_fg_procs-1)
16129 !----------------------
16132 allocate(gcart(3,0:nres))
16133 allocate(gxcart(3,0:nres))
16135 allocate(gradcag(3,nres))
16136 allocate(gradxag(3,nres))
16138 ! common /back_constr/
16139 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
16140 allocate(dutheta(nres))
16141 allocate(dugamma(nres))
16143 allocate(duscdiff(3,nres))
16144 allocate(duscdiffx(3,nres))
16146 !el i io:read_fragments
16147 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
16148 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
16150 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
16151 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
16152 allocate(mset(0:nprocs)) !(maxprocs/20)
16156 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
16157 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
16158 allocate(dUdconst(3,0:nres))
16159 allocate(dUdxconst(3,0:nres))
16160 allocate(dqwol(3,0:nres))
16161 allocate(dxqwol(3,0:nres))
16163 !----------------------
16165 ! common /sbridge/ in io_common: read_bridge
16166 !el allocate((:),allocatable :: iss !(maxss)
16167 ! common /links/ in io_common: read_bridge
16168 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
16169 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
16170 ! common /dyn_ssbond/
16171 ! and side-chain vectors in theta or phi.
16172 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
16176 dyn_ssbond_ij(i,j)=1.0d300
16181 allocate(idssb(nss),jdssb(nss))
16184 allocate(dyn_ss_mask(nres))
16187 dyn_ss_mask(i)=.false.
16189 !----------------------
16191 ! Parameters of the SCCOR term
16193 !el in io_conf: parmread
16194 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
16195 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
16196 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
16197 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
16198 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
16199 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
16200 ! allocate(vlor1sccor(maxterm_sccor,20,20))
16201 ! allocate(vlor2sccor(maxterm_sccor,20,20))
16202 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
16204 allocate(gloc_sc(3,0:2*nres,0:10))
16205 !(3,0:maxres2,10)maxres2=2*maxres
16206 allocate(dcostau(3,3,3,2*nres))
16207 allocate(dsintau(3,3,3,2*nres))
16208 allocate(dtauangle(3,3,3,2*nres))
16209 allocate(dcosomicron(3,3,3,2*nres))
16210 allocate(domicron(3,3,3,2*nres))
16211 !(3,3,3,maxres2)maxres2=2*maxres
16212 !----------------------
16215 allocate(varall(maxvar))
16216 !(maxvar)(maxvar=6*maxres)
16217 allocate(mask_theta(nres))
16218 allocate(mask_phi(nres))
16219 allocate(mask_side(nres))
16221 !----------------------
16224 allocate(uy(3,nres))
16225 allocate(uz(3,nres))
16227 allocate(uygrad(3,3,2,nres))
16228 allocate(uzgrad(3,3,2,nres))
16232 end subroutine alloc_ener_arrays
16233 !-----------------------------------------------------------------------------
16234 !-----------------------------------------------------------------------------