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)') 'evdw1',i,j,evdwij
2801 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2804 ! Calculate contributions to the Cartesian gradient.
2807 facvdw=-6*rrmij*(ev1+evdwij)
2808 facel=-3*rrmij*(el1+eesij)
2814 ! Radial derivatives. First process both termini of the fragment (i,j)
2820 ! ghalf=0.5D0*ggg(k)
2821 ! gelc(k,i)=gelc(k,i)+ghalf
2822 ! gelc(k,j)=gelc(k,j)+ghalf
2824 ! 9/28/08 AL Gradient compotents will be summed only at the end
2826 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2827 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2830 ! Loop over residues i+1 thru j-1.
2834 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2841 ! ghalf=0.5D0*ggg(k)
2842 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2843 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2845 ! 9/28/08 AL Gradient compotents will be summed only at the end
2847 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2848 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2851 ! Loop over residues i+1 thru j-1.
2855 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2862 fac=-3*rrmij*(facvdw+facvdw+facel)
2867 ! Radial derivatives. First process both termini of the fragment (i,j)
2873 ! ghalf=0.5D0*ggg(k)
2874 ! gelc(k,i)=gelc(k,i)+ghalf
2875 ! gelc(k,j)=gelc(k,j)+ghalf
2877 ! 9/28/08 AL Gradient compotents will be summed only at the end
2879 gelc_long(k,j)=gelc(k,j)+ggg(k)
2880 gelc_long(k,i)=gelc(k,i)-ggg(k)
2883 ! Loop over residues i+1 thru j-1.
2887 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2890 ! 9/28/08 AL Gradient compotents will be summed only at the end
2895 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2896 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2902 ecosa=2.0D0*fac3*fac1+fac4
2905 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2906 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2908 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2909 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2911 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2912 !d & (dcosg(k),k=1,3)
2914 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2917 ! ghalf=0.5D0*ggg(k)
2918 ! gelc(k,i)=gelc(k,i)+ghalf
2919 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2920 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2921 ! gelc(k,j)=gelc(k,j)+ghalf
2922 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2923 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2927 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2931 gelc(k,i)=gelc(k,i) &
2932 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
2933 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2934 gelc(k,j)=gelc(k,j) &
2935 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
2936 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2937 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2938 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2940 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
2941 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
2942 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2944 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2945 ! energy of a peptide unit is assumed in the form of a second-order
2946 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2947 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2948 ! are computed for EVERY pair of non-contiguous peptide groups.
2950 if (j.lt.nres-1) then
2961 muij(kkk)=mu(k,i)*mu(l,j)
2964 !d write (iout,*) 'EELEC: i',i,' j',j
2965 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
2966 !d write(iout,*) 'muij',muij
2967 ury=scalar(uy(1,i),erij)
2968 urz=scalar(uz(1,i),erij)
2969 vry=scalar(uy(1,j),erij)
2970 vrz=scalar(uz(1,j),erij)
2971 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2972 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2973 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2974 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2975 fac=dsqrt(-ael6i)*r3ij
2980 !d write (iout,'(4i5,4f10.5)')
2981 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2982 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2983 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2984 !d & uy(:,j),uz(:,j)
2985 !d write (iout,'(4f10.5)')
2986 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2987 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2988 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
2989 !d write (iout,'(9f10.5/)')
2990 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2991 ! Derivatives of the elements of A in virtual-bond vectors
2992 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2994 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2995 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2996 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2997 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2998 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2999 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3000 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3001 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3002 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3003 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3004 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3005 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3007 ! Compute radial contributions to the gradient
3025 ! Add the contributions coming from er
3028 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3029 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3030 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3031 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3034 ! Derivatives in DC(i)
3035 !grad ghalf1=0.5d0*agg(k,1)
3036 !grad ghalf2=0.5d0*agg(k,2)
3037 !grad ghalf3=0.5d0*agg(k,3)
3038 !grad ghalf4=0.5d0*agg(k,4)
3039 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
3040 -3.0d0*uryg(k,2)*vry)!+ghalf1
3041 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
3042 -3.0d0*uryg(k,2)*vrz)!+ghalf2
3043 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
3044 -3.0d0*urzg(k,2)*vry)!+ghalf3
3045 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
3046 -3.0d0*urzg(k,2)*vrz)!+ghalf4
3047 ! Derivatives in DC(i+1)
3048 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
3049 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3050 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
3051 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3052 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
3053 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3054 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
3055 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3056 ! Derivatives in DC(j)
3057 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
3058 -3.0d0*vryg(k,2)*ury)!+ghalf1
3059 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
3060 -3.0d0*vrzg(k,2)*ury)!+ghalf2
3061 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
3062 -3.0d0*vryg(k,2)*urz)!+ghalf3
3063 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
3064 -3.0d0*vrzg(k,2)*urz)!+ghalf4
3065 ! Derivatives in DC(j+1) or DC(nres-1)
3066 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
3067 -3.0d0*vryg(k,3)*ury)
3068 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
3069 -3.0d0*vrzg(k,3)*ury)
3070 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
3071 -3.0d0*vryg(k,3)*urz)
3072 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
3073 -3.0d0*vrzg(k,3)*urz)
3074 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
3076 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3089 aggi(k,l)=-aggi(k,l)
3090 aggi1(k,l)=-aggi1(k,l)
3091 aggj(k,l)=-aggj(k,l)
3092 aggj1(k,l)=-aggj1(k,l)
3095 if (j.lt.nres-1) then
3101 aggi(k,l)=-aggi(k,l)
3102 aggi1(k,l)=-aggi1(k,l)
3103 aggj(k,l)=-aggj(k,l)
3104 aggj1(k,l)=-aggj1(k,l)
3115 aggi(k,l)=-aggi(k,l)
3116 aggi1(k,l)=-aggi1(k,l)
3117 aggj(k,l)=-aggj(k,l)
3118 aggj1(k,l)=-aggj1(k,l)
3123 IF (wel_loc.gt.0.0d0) THEN
3124 ! Contribution to the local-electrostatic energy coming from the i-j pair
3125 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
3127 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3129 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3130 'eelloc',i,j,eel_loc_ij
3131 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
3132 ! if (energy_dec) write (iout,*) "muij",muij
3133 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3135 eel_loc=eel_loc+eel_loc_ij
3136 ! Partial derivatives in virtual-bond dihedral angles gamma
3138 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
3139 a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
3140 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3141 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
3142 a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
3143 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3144 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3146 ggg(l)=agg(l,1)*muij(1)+ &
3147 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3148 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3149 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3150 !grad ghalf=0.5d0*ggg(l)
3151 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
3152 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
3156 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3159 ! Remaining derivatives of eello
3161 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ &
3162 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3163 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ &
3164 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3165 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ &
3166 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3167 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ &
3168 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3171 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
3172 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
3173 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
3174 .and. num_conti.le.maxconts) then
3175 ! write (iout,*) i,j," entered corr"
3177 ! Calculate the contact function. The ith column of the array JCONT will
3178 ! contain the numbers of atoms that make contacts with the atom I (of numbers
3179 ! greater than I). The arrays FACONT and GACONT will contain the values of
3180 ! the contact function and its derivative.
3181 ! r0ij=1.02D0*rpp(iteli,itelj)
3182 ! r0ij=1.11D0*rpp(iteli,itelj)
3183 r0ij=2.20D0*rpp(iteli,itelj)
3184 ! r0ij=1.55D0*rpp(iteli,itelj)
3185 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3186 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
3187 if (fcont.gt.0.0D0) then
3188 num_conti=num_conti+1
3189 if (num_conti.gt.maxconts) then
3190 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
3191 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
3192 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
3193 ' will skip next contacts for this conf.', num_conti
3195 jcont_hb(num_conti,i)=j
3196 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
3197 !d & " jcont_hb",jcont_hb(num_conti,i)
3198 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
3199 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3200 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3202 d_cont(num_conti,i)=rij
3203 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3204 ! --- Electrostatic-interaction matrix ---
3205 a_chuj(1,1,num_conti,i)=a22
3206 a_chuj(1,2,num_conti,i)=a23
3207 a_chuj(2,1,num_conti,i)=a32
3208 a_chuj(2,2,num_conti,i)=a33
3209 ! --- Gradient of rij
3211 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3218 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3219 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3220 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3221 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3222 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3227 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3228 ! Calculate contact energies
3230 wij=cosa-3.0D0*cosb*cosg
3233 ! fac3=dsqrt(-ael6i)/r0ij**3
3234 fac3=dsqrt(-ael6i)*r3ij
3235 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3236 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3237 if (ees0tmp.gt.0) then
3238 ees0pij=dsqrt(ees0tmp)
3242 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3243 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3244 if (ees0tmp.gt.0) then
3245 ees0mij=dsqrt(ees0tmp)
3250 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3251 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3252 ! Diagnostics. Comment out or remove after debugging!
3253 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3254 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3255 ! ees0m(num_conti,i)=0.0D0
3257 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3258 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3259 ! Angular derivatives of the contact function
3260 ees0pij1=fac3/ees0pij
3261 ees0mij1=fac3/ees0mij
3262 fac3p=-3.0D0*fac3*rrmij
3263 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3264 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3266 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3267 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3268 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3269 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3270 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3271 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3272 ecosap=ecosa1+ecosa2
3273 ecosbp=ecosb1+ecosb2
3274 ecosgp=ecosg1+ecosg2
3275 ecosam=ecosa1-ecosa2
3276 ecosbm=ecosb1-ecosb2
3277 ecosgm=ecosg1-ecosg2
3286 facont_hb(num_conti,i)=fcont
3287 fprimcont=fprimcont/rij
3288 !d facont_hb(num_conti,i)=1.0D0
3289 ! Following line is for diagnostics.
3292 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3293 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3296 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3297 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3299 gggp(1)=gggp(1)+ees0pijp*xj
3300 gggp(2)=gggp(2)+ees0pijp*yj
3301 gggp(3)=gggp(3)+ees0pijp*zj
3302 gggm(1)=gggm(1)+ees0mijp*xj
3303 gggm(2)=gggm(2)+ees0mijp*yj
3304 gggm(3)=gggm(3)+ees0mijp*zj
3305 ! Derivatives due to the contact function
3306 gacont_hbr(1,num_conti,i)=fprimcont*xj
3307 gacont_hbr(2,num_conti,i)=fprimcont*yj
3308 gacont_hbr(3,num_conti,i)=fprimcont*zj
3311 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
3312 ! following the change of gradient-summation algorithm.
3314 !grad ghalfp=0.5D0*gggp(k)
3315 !grad ghalfm=0.5D0*gggm(k)
3316 gacontp_hb1(k,num_conti,i)= & !ghalfp+
3317 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3318 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3319 gacontp_hb2(k,num_conti,i)= & !ghalfp+
3320 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3321 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3322 gacontp_hb3(k,num_conti,i)=gggp(k)
3323 gacontm_hb1(k,num_conti,i)= & !ghalfm+
3324 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3325 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3326 gacontm_hb2(k,num_conti,i)= & !ghalfm+
3327 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3328 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3329 gacontm_hb3(k,num_conti,i)=gggm(k)
3331 ! Diagnostics. Comment out or remove after debugging!
3333 !diag gacontp_hb1(k,num_conti,i)=0.0D0
3334 !diag gacontp_hb2(k,num_conti,i)=0.0D0
3335 !diag gacontp_hb3(k,num_conti,i)=0.0D0
3336 !diag gacontm_hb1(k,num_conti,i)=0.0D0
3337 !diag gacontm_hb2(k,num_conti,i)=0.0D0
3338 !diag gacontm_hb3(k,num_conti,i)=0.0D0
3341 endif ! num_conti.le.maxconts
3344 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3347 ghalf=0.5d0*agg(l,k)
3348 aggi(l,k)=aggi(l,k)+ghalf
3349 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3350 aggj(l,k)=aggj(l,k)+ghalf
3353 if (j.eq.nres-1 .and. i.lt.j-2) then
3356 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3361 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
3363 end subroutine eelecij
3364 !-----------------------------------------------------------------------------
3365 subroutine eturn3(i,eello_turn3)
3366 ! Third- and fourth-order contributions from turns
3369 ! implicit real*8 (a-h,o-z)
3370 ! include 'DIMENSIONS'
3371 ! include 'COMMON.IOUNITS'
3372 ! include 'COMMON.GEO'
3373 ! include 'COMMON.VAR'
3374 ! include 'COMMON.LOCAL'
3375 ! include 'COMMON.CHAIN'
3376 ! include 'COMMON.DERIV'
3377 ! include 'COMMON.INTERACT'
3378 ! include 'COMMON.CONTACTS'
3379 ! include 'COMMON.TORSION'
3380 ! include 'COMMON.VECTORS'
3381 ! include 'COMMON.FFIELD'
3382 ! include 'COMMON.CONTROL'
3383 real(kind=8),dimension(3) :: ggg
3384 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
3385 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
3386 real(kind=8),dimension(2) :: auxvec,auxvec1
3387 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3388 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
3389 !el integer :: num_conti,j1,j2
3390 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3391 !el dz_normi,xmedi,ymedi,zmedi
3393 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3394 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3398 real(kind=8) :: eello_turn3
3401 ! write (iout,*) "eturn3",i,j,j1,j2
3406 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3408 ! Third-order contributions
3415 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3416 !d call checkint_turn3(i,a_temp,eello_turn3_num)
3417 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3418 call transpose2(auxmat(1,1),auxmat1(1,1))
3419 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3420 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3421 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3422 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3423 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
3424 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
3425 !d & ' eello_turn3_num',4*eello_turn3_num
3426 ! Derivatives in gamma(i)
3427 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3428 call transpose2(auxmat2(1,1),auxmat3(1,1))
3429 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3430 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3431 ! Derivatives in gamma(i+1)
3432 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3433 call transpose2(auxmat2(1,1),auxmat3(1,1))
3434 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3435 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
3436 +0.5d0*(pizda(1,1)+pizda(2,2))
3437 ! Cartesian derivatives
3439 ! ghalf1=0.5d0*agg(l,1)
3440 ! ghalf2=0.5d0*agg(l,2)
3441 ! ghalf3=0.5d0*agg(l,3)
3442 ! ghalf4=0.5d0*agg(l,4)
3443 a_temp(1,1)=aggi(l,1)!+ghalf1
3444 a_temp(1,2)=aggi(l,2)!+ghalf2
3445 a_temp(2,1)=aggi(l,3)!+ghalf3
3446 a_temp(2,2)=aggi(l,4)!+ghalf4
3447 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3448 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
3449 +0.5d0*(pizda(1,1)+pizda(2,2))
3450 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3451 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3452 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3453 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3454 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3455 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
3456 +0.5d0*(pizda(1,1)+pizda(2,2))
3457 a_temp(1,1)=aggj(l,1)!+ghalf1
3458 a_temp(1,2)=aggj(l,2)!+ghalf2
3459 a_temp(2,1)=aggj(l,3)!+ghalf3
3460 a_temp(2,2)=aggj(l,4)!+ghalf4
3461 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3462 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
3463 +0.5d0*(pizda(1,1)+pizda(2,2))
3464 a_temp(1,1)=aggj1(l,1)
3465 a_temp(1,2)=aggj1(l,2)
3466 a_temp(2,1)=aggj1(l,3)
3467 a_temp(2,2)=aggj1(l,4)
3468 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3469 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
3470 +0.5d0*(pizda(1,1)+pizda(2,2))
3473 end subroutine eturn3
3474 !-----------------------------------------------------------------------------
3475 subroutine eturn4(i,eello_turn4)
3476 ! Third- and fourth-order contributions from turns
3479 ! implicit real*8 (a-h,o-z)
3480 ! include 'DIMENSIONS'
3481 ! include 'COMMON.IOUNITS'
3482 ! include 'COMMON.GEO'
3483 ! include 'COMMON.VAR'
3484 ! include 'COMMON.LOCAL'
3485 ! include 'COMMON.CHAIN'
3486 ! include 'COMMON.DERIV'
3487 ! include 'COMMON.INTERACT'
3488 ! include 'COMMON.CONTACTS'
3489 ! include 'COMMON.TORSION'
3490 ! include 'COMMON.VECTORS'
3491 ! include 'COMMON.FFIELD'
3492 ! include 'COMMON.CONTROL'
3493 real(kind=8),dimension(3) :: ggg
3494 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
3495 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
3496 real(kind=8),dimension(2) :: auxvec,auxvec1
3497 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3498 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
3499 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3500 !el dz_normi,xmedi,ymedi,zmedi
3501 !el integer :: num_conti,j1,j2
3502 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3503 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3506 integer :: i,j,iti1,iti2,iti3,l
3507 real(kind=8) :: eello_turn4,s1,s2,s3
3510 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3512 ! Fourth-order contributions
3520 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3521 !d call checkint_turn4(i,a_temp,eello_turn4_num)
3522 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3527 iti1=itortyp(itype(i+1))
3528 iti2=itortyp(itype(i+2))
3529 iti3=itortyp(itype(i+3))
3530 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3531 call transpose2(EUg(1,1,i+1),e1t(1,1))
3532 call transpose2(Eug(1,1,i+2),e2t(1,1))
3533 call transpose2(Eug(1,1,i+3),e3t(1,1))
3534 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3535 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3536 s1=scalar2(b1(1,iti2),auxvec(1))
3537 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3538 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3539 s2=scalar2(b1(1,iti1),auxvec(1))
3540 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3541 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3542 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3543 eello_turn4=eello_turn4-(s1+s2+s3)
3544 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3545 'eturn4',i,j,-(s1+s2+s3)
3546 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3547 !d & ' eello_turn4_num',8*eello_turn4_num
3548 ! Derivatives in gamma(i)
3549 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3550 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3551 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3552 s1=scalar2(b1(1,iti2),auxvec(1))
3553 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3554 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3555 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3556 ! Derivatives in gamma(i+1)
3557 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3558 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3559 s2=scalar2(b1(1,iti1),auxvec(1))
3560 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3561 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3562 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3563 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3564 ! Derivatives in gamma(i+2)
3565 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3566 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3567 s1=scalar2(b1(1,iti2),auxvec(1))
3568 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3569 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3570 s2=scalar2(b1(1,iti1),auxvec(1))
3571 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3572 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3573 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3574 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3575 ! Cartesian derivatives
3576 ! Derivatives of this turn contributions in DC(i+2)
3577 if (j.lt.nres-1) then
3579 a_temp(1,1)=agg(l,1)
3580 a_temp(1,2)=agg(l,2)
3581 a_temp(2,1)=agg(l,3)
3582 a_temp(2,2)=agg(l,4)
3583 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3584 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3585 s1=scalar2(b1(1,iti2),auxvec(1))
3586 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3587 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3588 s2=scalar2(b1(1,iti1),auxvec(1))
3589 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3590 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3591 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3593 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3596 ! Remaining derivatives of this turn contribution
3598 a_temp(1,1)=aggi(l,1)
3599 a_temp(1,2)=aggi(l,2)
3600 a_temp(2,1)=aggi(l,3)
3601 a_temp(2,2)=aggi(l,4)
3602 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3603 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3604 s1=scalar2(b1(1,iti2),auxvec(1))
3605 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3606 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3607 s2=scalar2(b1(1,iti1),auxvec(1))
3608 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3609 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3610 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3611 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3612 a_temp(1,1)=aggi1(l,1)
3613 a_temp(1,2)=aggi1(l,2)
3614 a_temp(2,1)=aggi1(l,3)
3615 a_temp(2,2)=aggi1(l,4)
3616 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3617 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3618 s1=scalar2(b1(1,iti2),auxvec(1))
3619 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3620 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3621 s2=scalar2(b1(1,iti1),auxvec(1))
3622 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3623 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3624 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3625 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3626 a_temp(1,1)=aggj(l,1)
3627 a_temp(1,2)=aggj(l,2)
3628 a_temp(2,1)=aggj(l,3)
3629 a_temp(2,2)=aggj(l,4)
3630 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3631 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3632 s1=scalar2(b1(1,iti2),auxvec(1))
3633 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3634 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3635 s2=scalar2(b1(1,iti1),auxvec(1))
3636 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3637 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3638 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3639 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3640 a_temp(1,1)=aggj1(l,1)
3641 a_temp(1,2)=aggj1(l,2)
3642 a_temp(2,1)=aggj1(l,3)
3643 a_temp(2,2)=aggj1(l,4)
3644 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3645 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3646 s1=scalar2(b1(1,iti2),auxvec(1))
3647 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3648 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3649 s2=scalar2(b1(1,iti1),auxvec(1))
3650 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3651 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3652 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3653 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3654 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3657 end subroutine eturn4
3658 !-----------------------------------------------------------------------------
3659 subroutine unormderiv(u,ugrad,unorm,ungrad)
3660 ! This subroutine computes the derivatives of a normalized vector u, given
3661 ! the derivatives computed without normalization conditions, ugrad. Returns
3664 real(kind=8),dimension(3) :: u,vec
3665 real(kind=8),dimension(3,3) ::ugrad,ungrad
3666 real(kind=8) :: unorm !,scalar
3668 ! write (2,*) 'ugrad',ugrad
3671 vec(i)=scalar(ugrad(1,i),u(1))
3673 ! write (2,*) 'vec',vec
3676 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3679 ! write (2,*) 'ungrad',ungrad
3681 end subroutine unormderiv
3682 !-----------------------------------------------------------------------------
3683 subroutine escp_soft_sphere(evdw2,evdw2_14)
3685 ! This subroutine calculates the excluded-volume interaction energy between
3686 ! peptide-group centers and side chains and its gradient in virtual-bond and
3687 ! side-chain vectors.
3689 ! implicit real*8 (a-h,o-z)
3690 ! include 'DIMENSIONS'
3691 ! include 'COMMON.GEO'
3692 ! include 'COMMON.VAR'
3693 ! include 'COMMON.LOCAL'
3694 ! include 'COMMON.CHAIN'
3695 ! include 'COMMON.DERIV'
3696 ! include 'COMMON.INTERACT'
3697 ! include 'COMMON.FFIELD'
3698 ! include 'COMMON.IOUNITS'
3699 ! include 'COMMON.CONTROL'
3700 real(kind=8),dimension(3) :: ggg
3702 integer :: i,iint,j,k,iteli,itypj
3703 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
3704 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
3709 !d print '(a)','Enter ESCP'
3710 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3711 do i=iatscp_s,iatscp_e
3712 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3714 xi=0.5D0*(c(1,i)+c(1,i+1))
3715 yi=0.5D0*(c(2,i)+c(2,i+1))
3716 zi=0.5D0*(c(3,i)+c(3,i+1))
3718 do iint=1,nscp_gr(i)
3720 do j=iscpstart(i,iint),iscpend(i,iint)
3721 if (itype(j).eq.ntyp1) cycle
3722 itypj=iabs(itype(j))
3723 ! Uncomment following three lines for SC-p interactions
3727 ! Uncomment following three lines for Ca-p interactions
3731 rij=xj*xj+yj*yj+zj*zj
3734 if (rij.lt.r0ijsq) then
3735 evdwij=0.25d0*(rij-r0ijsq)**2
3743 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
3748 !grad if (j.lt.i) then
3749 !d write (iout,*) 'j<i'
3750 ! Uncomment following three lines for SC-p interactions
3752 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3755 !d write (iout,*) 'j>i'
3757 !grad ggg(k)=-ggg(k)
3758 ! Uncomment following line for SC-p interactions
3759 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3763 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3765 !grad kstart=min0(i+1,j)
3766 !grad kend=max0(i-1,j-1)
3767 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3768 !d write (iout,*) ggg(1),ggg(2),ggg(3)
3769 !grad do k=kstart,kend
3771 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3775 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3776 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3783 end subroutine escp_soft_sphere
3784 !-----------------------------------------------------------------------------
3785 subroutine escp(evdw2,evdw2_14)
3787 ! This subroutine calculates the excluded-volume interaction energy between
3788 ! peptide-group centers and side chains and its gradient in virtual-bond and
3789 ! side-chain vectors.
3791 ! implicit real*8 (a-h,o-z)
3792 ! include 'DIMENSIONS'
3793 ! include 'COMMON.GEO'
3794 ! include 'COMMON.VAR'
3795 ! include 'COMMON.LOCAL'
3796 ! include 'COMMON.CHAIN'
3797 ! include 'COMMON.DERIV'
3798 ! include 'COMMON.INTERACT'
3799 ! include 'COMMON.FFIELD'
3800 ! include 'COMMON.IOUNITS'
3801 ! include 'COMMON.CONTROL'
3802 real(kind=8),dimension(3) :: ggg
3804 integer :: i,iint,j,k,iteli,itypj
3805 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
3810 !d print '(a)','Enter ESCP'
3811 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3812 do i=iatscp_s,iatscp_e
3813 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3815 xi=0.5D0*(c(1,i)+c(1,i+1))
3816 yi=0.5D0*(c(2,i)+c(2,i+1))
3817 zi=0.5D0*(c(3,i)+c(3,i+1))
3819 do iint=1,nscp_gr(i)
3821 do j=iscpstart(i,iint),iscpend(i,iint)
3822 itypj=iabs(itype(j))
3823 if (itypj.eq.ntyp1) cycle
3824 ! Uncomment following three lines for SC-p interactions
3828 ! Uncomment following three lines for Ca-p interactions
3832 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3834 e1=fac*fac*aad(itypj,iteli)
3835 e2=fac*bad(itypj,iteli)
3836 if (iabs(j-i) .le. 2) then
3839 evdw2_14=evdw2_14+e1+e2
3843 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
3844 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
3845 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3848 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
3850 fac=-(evdwij+e1)*rrij
3854 !grad if (j.lt.i) then
3855 !d write (iout,*) 'j<i'
3856 ! Uncomment following three lines for SC-p interactions
3858 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3861 !d write (iout,*) 'j>i'
3863 !grad ggg(k)=-ggg(k)
3864 ! Uncomment following line for SC-p interactions
3865 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3866 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3870 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3872 !grad kstart=min0(i+1,j)
3873 !grad kend=max0(i-1,j-1)
3874 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3875 !d write (iout,*) ggg(1),ggg(2),ggg(3)
3876 !grad do k=kstart,kend
3878 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3882 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3883 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3891 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3892 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
3893 gradx_scp(j,i)=expon*gradx_scp(j,i)
3896 !******************************************************************************
3900 ! To save time the factor EXPON has been extracted from ALL components
3901 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
3904 !******************************************************************************
3907 !-----------------------------------------------------------------------------
3908 subroutine edis(ehpb)
3910 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3912 ! implicit real*8 (a-h,o-z)
3913 ! include 'DIMENSIONS'
3914 ! include 'COMMON.SBRIDGE'
3915 ! include 'COMMON.CHAIN'
3916 ! include 'COMMON.DERIV'
3917 ! include 'COMMON.VAR'
3918 ! include 'COMMON.INTERACT'
3919 ! include 'COMMON.IOUNITS'
3920 real(kind=8),dimension(3) :: ggg
3922 integer :: i,j,ii,jj,iii,jjj,k
3923 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
3926 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
3927 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
3928 if (link_end.eq.0) return
3929 do i=link_start,link_end
3930 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3931 ! CA-CA distance used in regularization of structure.
3934 ! iii and jjj point to the residues for which the distance is assigned.
3935 if (ii.gt.nres) then
3942 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
3943 ! & dhpb(i),dhpb1(i),forcon(i)
3944 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
3945 ! distance and angle dependent SS bond potential.
3946 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
3947 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
3948 if (.not.dyn_ss .and. i.le.nss) then
3949 ! 15/02/13 CC dynamic SSbond - additional check
3950 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. &
3951 iabs(itype(jjj)).eq.1) then
3952 call ssbond_ene(iii,jjj,eij)
3954 !d write (iout,*) "eij",eij
3957 ! Calculate the distance between the two points and its difference from the
3961 ! Get the force constant corresponding to this distance.
3963 ! Calculate the contribution to energy.
3964 ehpb=ehpb+waga*rdis*rdis
3966 ! Evaluate gradient.
3969 !d print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3970 !d & ' waga=',waga,' fac=',fac
3972 ggg(j)=fac*(c(j,jj)-c(j,ii))
3974 !d print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3975 ! If this is a SC-SC distance, we need to calculate the contributions to the
3976 ! Cartesian gradient in the SC vectors (ghpbx).
3979 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3980 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3983 !grad do j=iii,jjj-1
3985 !grad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3989 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3990 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3997 !-----------------------------------------------------------------------------
3998 subroutine ssbond_ene(i,j,eij)
4000 ! Calculate the distance and angle dependent SS-bond potential energy
4001 ! using a free-energy function derived based on RHF/6-31G** ab initio
4002 ! calculations of diethyl disulfide.
4004 ! A. Liwo and U. Kozlowska, 11/24/03
4006 ! implicit real*8 (a-h,o-z)
4007 ! include 'DIMENSIONS'
4008 ! include 'COMMON.SBRIDGE'
4009 ! include 'COMMON.CHAIN'
4010 ! include 'COMMON.DERIV'
4011 ! include 'COMMON.LOCAL'
4012 ! include 'COMMON.INTERACT'
4013 ! include 'COMMON.VAR'
4014 ! include 'COMMON.IOUNITS'
4015 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
4017 integer :: i,j,itypi,itypj,k
4018 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
4019 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
4020 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
4023 itypi=iabs(itype(i))
4027 dxi=dc_norm(1,nres+i)
4028 dyi=dc_norm(2,nres+i)
4029 dzi=dc_norm(3,nres+i)
4030 ! dsci_inv=dsc_inv(itypi)
4031 dsci_inv=vbld_inv(nres+i)
4032 itypj=iabs(itype(j))
4033 ! dscj_inv=dsc_inv(itypj)
4034 dscj_inv=vbld_inv(nres+j)
4038 dxj=dc_norm(1,nres+j)
4039 dyj=dc_norm(2,nres+j)
4040 dzj=dc_norm(3,nres+j)
4041 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4046 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4047 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4048 om12=dxi*dxj+dyi*dyj+dzi*dzj
4050 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4051 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4057 deltat12=om2-om1+2.0d0
4059 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
4060 +akct*deltad*deltat12 &
4061 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4062 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4063 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4064 ! & " deltat12",deltat12," eij",eij
4065 ed=2*akcm*deltad+akct*deltat12
4067 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4068 eom1=-2*akth*deltat1-pom1-om2*pom2
4069 eom2= 2*akth*deltat2+pom1-om1*pom2
4072 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4073 ghpbx(k,i)=ghpbx(k,i)-ggk &
4074 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
4075 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4076 ghpbx(k,j)=ghpbx(k,j)+ggk &
4077 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
4078 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4079 ghpbc(k,i)=ghpbc(k,i)-ggk
4080 ghpbc(k,j)=ghpbc(k,j)+ggk
4083 ! Calculate the components of the gradient in DC and X
4087 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4091 end subroutine ssbond_ene
4092 !-----------------------------------------------------------------------------
4093 subroutine ebond(estr)
4095 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4097 ! implicit real*8 (a-h,o-z)
4098 ! include 'DIMENSIONS'
4099 ! include 'COMMON.LOCAL'
4100 ! include 'COMMON.GEO'
4101 ! include 'COMMON.INTERACT'
4102 ! include 'COMMON.DERIV'
4103 ! include 'COMMON.VAR'
4104 ! include 'COMMON.CHAIN'
4105 ! include 'COMMON.IOUNITS'
4106 ! include 'COMMON.NAMES'
4107 ! include 'COMMON.FFIELD'
4108 ! include 'COMMON.CONTROL'
4109 ! include 'COMMON.SETUP'
4110 real(kind=8),dimension(3) :: u,ud
4112 integer :: i,j,iti,nbi,k
4113 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
4118 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
4119 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
4121 do i=ibondp_start,ibondp_end
4122 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4123 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4125 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
4128 if (energy_dec) write(iout,*) &
4129 "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4131 diff = vbld(i)-vbldp0
4132 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
4133 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4136 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4138 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4141 estr=0.5d0*AKP*estr+estr1
4143 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4145 do i=ibond_start,ibond_end
4147 if (iti.ne.10 .and. iti.ne.ntyp1) then
4150 diff=vbld(i+nres)-vbldsc0(1,iti)
4151 if (energy_dec) write (iout,*) &
4152 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
4153 AKSC(1,iti),AKSC(1,iti)*diff*diff
4154 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4156 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4160 diff=vbld(i+nres)-vbldsc0(j,iti)
4161 ud(j)=aksc(j,iti)*diff
4162 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4176 uprod2=uprod2*u(k)*u(k)
4180 usumsqder=usumsqder+ud(j)*uprod2
4182 estr=estr+uprod/usum
4184 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4190 end subroutine ebond
4192 !-----------------------------------------------------------------------------
4193 subroutine ebend(etheta)
4195 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4196 ! angles gamma and its derivatives in consecutive thetas and gammas.
4199 ! implicit real*8 (a-h,o-z)
4200 ! include 'DIMENSIONS'
4201 ! include 'COMMON.LOCAL'
4202 ! include 'COMMON.GEO'
4203 ! include 'COMMON.INTERACT'
4204 ! include 'COMMON.DERIV'
4205 ! include 'COMMON.VAR'
4206 ! include 'COMMON.CHAIN'
4207 ! include 'COMMON.IOUNITS'
4208 ! include 'COMMON.NAMES'
4209 ! include 'COMMON.FFIELD'
4210 ! include 'COMMON.CONTROL'
4211 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
4212 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4213 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
4215 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
4216 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4217 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4219 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
4221 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
4222 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
4223 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
4224 real(kind=8),dimension(2) :: y,z
4227 ! time11=dexp(-2*time)
4230 ! write (*,'(a,i2)') 'EBEND ICG=',icg
4231 do i=ithet_start,ithet_end
4232 if (itype(i-1).eq.ntyp1) cycle
4233 ! Zero the energy function and its derivative at 0 or pi.
4234 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4236 ichir1=isign(1,itype(i-2))
4237 ichir2=isign(1,itype(i))
4238 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4239 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4240 if (itype(i-1).eq.10) then
4241 itype1=isign(10,itype(i-2))
4242 ichir11=isign(1,itype(i-2))
4243 ichir12=isign(1,itype(i-2))
4244 itype2=isign(10,itype(i))
4245 ichir21=isign(1,itype(i))
4246 ichir22=isign(1,itype(i))
4249 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4252 if (phii.ne.phii) phii=150.0
4262 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4265 if (phii1.ne.phii1) phii1=150.0
4277 ! Calculate the "mean" value of theta from the part of the distribution
4278 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4279 ! In following comments this theta will be referred to as t_c.
4280 thet_pred_mean=0.0d0
4282 athetk=athet(k,it,ichir1,ichir2)
4283 bthetk=bthet(k,it,ichir1,ichir2)
4285 athetk=athet(k,itype1,ichir11,ichir12)
4286 bthetk=bthet(k,itype2,ichir21,ichir22)
4288 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4290 dthett=thet_pred_mean*ssd
4291 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4292 ! Derivatives of the "mean" values in gamma1 and gamma2.
4293 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
4294 +athet(2,it,ichir1,ichir2)*y(1))*ss
4295 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
4296 +bthet(2,it,ichir1,ichir2)*z(1))*ss
4298 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
4299 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
4300 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
4301 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4303 if (theta(i).gt.pi-delta) then
4304 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
4306 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4307 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4308 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
4310 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
4312 else if (theta(i).lt.delta) then
4313 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4314 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4315 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
4317 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4318 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
4321 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
4324 etheta=etheta+ethetai
4325 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
4327 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4328 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4329 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4331 ! Ufff.... We've done all this!!!
4333 end subroutine ebend
4334 !-----------------------------------------------------------------------------
4335 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
4338 ! implicit real*8 (a-h,o-z)
4339 ! include 'DIMENSIONS'
4340 ! include 'COMMON.LOCAL'
4341 ! include 'COMMON.IOUNITS'
4342 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
4343 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4344 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
4346 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
4348 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
4349 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4350 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4352 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
4353 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
4355 ! Calculate the contributions to both Gaussian lobes.
4356 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4357 ! The "polynomial part" of the "standard deviation" of this part of
4361 sig=sig*thet_pred_mean+polthet(j,it)
4363 ! Derivative of the "interior part" of the "standard deviation of the"
4364 ! gamma-dependent Gaussian lobe in t_c.
4365 sigtc=3*polthet(3,it)
4367 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4370 ! Set the parameters of both Gaussian lobes of the distribution.
4371 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4372 fac=sig*sig+sigc0(it)
4375 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4376 sigsqtc=-4.0D0*sigcsq*sigtc
4377 ! print *,i,sig,sigtc,sigsqtc
4378 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
4379 sigtc=-sigtc/(fac*fac)
4380 ! Following variable is sigma(t_c)**(-2)
4381 sigcsq=sigcsq*sigcsq
4383 sig0inv=1.0D0/sig0i**2
4384 delthec=thetai-thet_pred_mean
4385 delthe0=thetai-theta0i
4386 term1=-0.5D0*sigcsq*delthec*delthec
4387 term2=-0.5D0*sig0inv*delthe0*delthe0
4388 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4389 ! NaNs in taking the logarithm. We extract the largest exponent which is added
4390 ! to the energy (this being the log of the distribution) at the end of energy
4391 ! term evaluation for this virtual-bond angle.
4392 if (term1.gt.term2) then
4394 term2=dexp(term2-termm)
4398 term1=dexp(term1-termm)
4401 ! The ratio between the gamma-independent and gamma-dependent lobes of
4402 ! the distribution is a Gaussian function of thet_pred_mean too.
4403 diffak=gthet(2,it)-thet_pred_mean
4404 ratak=diffak/gthet(3,it)**2
4405 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4406 ! Let's differentiate it in thet_pred_mean NOW.
4408 ! Now put together the distribution terms to make complete distribution.
4409 termexp=term1+ak*term2
4410 termpre=sigc+ak*sig0i
4411 ! Contribution of the bending energy from this theta is just the -log of
4412 ! the sum of the contributions from the two lobes and the pre-exponential
4413 ! factor. Simple enough, isn't it?
4414 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4415 ! NOW the derivatives!!!
4416 ! 6/6/97 Take into account the deformation.
4417 E_theta=(delthec*sigcsq*term1 &
4418 +ak*delthe0*sig0inv*term2)/termexp
4419 E_tc=((sigtc+aktc*sig0i)/termpre &
4420 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
4421 aktc*term2)/termexp)
4423 end subroutine theteng
4425 !-----------------------------------------------------------------------------
4426 subroutine ebend(etheta)
4428 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4429 ! angles gamma and its derivatives in consecutive thetas and gammas.
4430 ! ab initio-derived potentials from
4431 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4433 ! implicit real*8 (a-h,o-z)
4434 ! include 'DIMENSIONS'
4435 ! include 'COMMON.LOCAL'
4436 ! include 'COMMON.GEO'
4437 ! include 'COMMON.INTERACT'
4438 ! include 'COMMON.DERIV'
4439 ! include 'COMMON.VAR'
4440 ! include 'COMMON.CHAIN'
4441 ! include 'COMMON.IOUNITS'
4442 ! include 'COMMON.NAMES'
4443 ! include 'COMMON.FFIELD'
4444 ! include 'COMMON.CONTROL'
4445 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
4446 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
4447 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
4448 logical :: lprn=.false., lprn1=.false.
4450 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
4451 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
4452 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl
4455 do i=ithet_start,ithet_end
4456 if (itype(i-1).eq.ntyp1) cycle
4457 if (itype(i-2).eq.ntyp1.or.itype(i).eq.ntyp1) cycle
4458 if (iabs(itype(i+1)).eq.20) iblock=2
4459 if (iabs(itype(i+1)).ne.20) iblock=1
4463 theti2=0.5d0*theta(i)
4464 ityp2=ithetyp((itype(i-1)))
4466 coskt(k)=dcos(k*theti2)
4467 sinkt(k)=dsin(k*theti2)
4469 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4472 if (phii.ne.phii) phii=150.0
4476 ityp1=ithetyp((itype(i-2)))
4477 ! propagation of chirality for glycine type
4479 cosph1(k)=dcos(k*phii)
4480 sinph1(k)=dsin(k*phii)
4484 ityp1=ithetyp(itype(i-2))
4490 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4493 if (phii1.ne.phii1) phii1=150.0
4498 ityp3=ithetyp((itype(i)))
4500 cosph2(k)=dcos(k*phii1)
4501 sinph2(k)=dsin(k*phii1)
4505 ityp3=ithetyp(itype(i))
4511 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4514 ccl=cosph1(l)*cosph2(k-l)
4515 ssl=sinph1(l)*sinph2(k-l)
4516 scl=sinph1(l)*cosph2(k-l)
4517 csl=cosph1(l)*sinph2(k-l)
4518 cosph1ph2(l,k)=ccl-ssl
4519 cosph1ph2(k,l)=ccl+ssl
4520 sinph1ph2(l,k)=scl+csl
4521 sinph1ph2(k,l)=scl-csl
4525 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
4526 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4527 write (iout,*) "coskt and sinkt"
4529 write (iout,*) k,coskt(k),sinkt(k)
4533 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4534 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
4537 write (iout,*) "k",k,&
4538 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
4542 write (iout,*) "cosph and sinph"
4544 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4546 write (iout,*) "cosph1ph2 and sinph2ph2"
4549 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
4550 sinph1ph2(l,k),sinph1ph2(k,l)
4553 write(iout,*) "ethetai",ethetai
4557 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
4558 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
4559 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
4560 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4561 ethetai=ethetai+sinkt(m)*aux
4562 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4563 dephii=dephii+k*sinkt(m)* &
4564 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
4565 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4566 dephii1=dephii1+k*sinkt(m)* &
4567 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
4568 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4570 write (iout,*) "m",m," k",k," bbthet", &
4571 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
4572 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
4573 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
4574 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4578 write(iout,*) "ethetai",ethetai
4582 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
4583 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
4584 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
4585 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4586 ethetai=ethetai+sinkt(m)*aux
4587 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4588 dephii=dephii+l*sinkt(m)* &
4589 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
4590 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
4591 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
4592 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4593 dephii1=dephii1+(k-l)*sinkt(m)* &
4594 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
4595 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
4596 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
4597 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4599 write (iout,*) "m",m," k",k," l",l," ffthet",&
4600 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
4601 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
4602 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
4603 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
4605 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
4606 cosph1ph2(k,l)*sinkt(m),&
4607 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4615 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
4616 i,theta(i)*rad2deg,phii*rad2deg,&
4617 phii1*rad2deg,ethetai
4619 etheta=etheta+ethetai
4620 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
4622 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4623 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4624 gloc(nphi+i-2,icg)=wang*dethetai
4627 end subroutine ebend
4630 !-----------------------------------------------------------------------------
4631 subroutine esc(escloc)
4632 ! Calculate the local energy of a side chain and its derivatives in the
4633 ! corresponding virtual-bond valence angles THETA and the spherical angles
4637 ! implicit real*8 (a-h,o-z)
4638 ! include 'DIMENSIONS'
4639 ! include 'COMMON.GEO'
4640 ! include 'COMMON.LOCAL'
4641 ! include 'COMMON.VAR'
4642 ! include 'COMMON.INTERACT'
4643 ! include 'COMMON.DERIV'
4644 ! include 'COMMON.CHAIN'
4645 ! include 'COMMON.IOUNITS'
4646 ! include 'COMMON.NAMES'
4647 ! include 'COMMON.FFIELD'
4648 ! include 'COMMON.CONTROL'
4649 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
4650 ddersc0,ddummy,xtemp,temp
4651 !el real(kind=8) :: time11,time12,time112,theti
4652 real(kind=8) :: escloc,delta
4653 !el integer :: it,nlobit
4654 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4657 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
4658 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
4661 ! write (iout,'(a)') 'ESC'
4662 do i=loc_start,loc_end
4664 if (it.eq.ntyp1) cycle
4665 if (it.eq.10) goto 1
4666 nlobit=nlob(iabs(it))
4667 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
4668 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4669 theti=theta(i+1)-pipol
4674 if (x(2).gt.pi-delta) then
4678 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4680 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4681 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
4683 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
4684 ddersc0(1),dersc(1))
4685 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
4686 ddersc0(3),dersc(3))
4688 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4690 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4691 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
4692 dersc0(2),esclocbi,dersc02)
4693 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
4695 call splinthet(x(2),0.5d0*delta,ss,ssd)
4700 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4702 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4703 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4705 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4707 ! write (iout,*) escloci
4708 else if (x(2).lt.delta) then
4712 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4714 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4715 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
4717 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
4718 ddersc0(1),dersc(1))
4719 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
4720 ddersc0(3),dersc(3))
4722 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4724 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4725 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
4726 dersc0(2),esclocbi,dersc02)
4727 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
4732 call splinthet(x(2),0.5d0*delta,ss,ssd)
4734 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4736 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4737 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4739 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4740 ! write (iout,*) escloci
4742 call enesc(x,escloci,dersc,ddummy,.false.)
4745 escloc=escloc+escloci
4746 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
4748 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4750 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
4752 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4753 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4758 !-----------------------------------------------------------------------------
4759 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4762 ! implicit real*8 (a-h,o-z)
4763 ! include 'DIMENSIONS'
4764 ! include 'COMMON.GEO'
4765 ! include 'COMMON.LOCAL'
4766 ! include 'COMMON.IOUNITS'
4767 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4768 real(kind=8),dimension(3) :: x,z,dersc,ddersc
4769 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
4770 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
4771 real(kind=8) :: escloci
4774 integer :: j,iii,l,k !el,it,nlobit
4775 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
4776 !el time11,time12,time112
4777 ! write (iout,*) 'it=',it,' nlobit=',nlobit
4781 if (mixed) ddersc(j)=0.0d0
4785 ! Because of periodicity of the dependence of the SC energy in omega we have
4786 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4787 ! To avoid underflows, first compute & store the exponents.
4795 z(k)=x(k)-censc(k,j,it)
4800 Axk=Axk+gaussc(l,k,j,it)*z(l)
4806 expfac=expfac+Ax(k,j,iii)*z(k)
4814 ! As in the case of ebend, we want to avoid underflows in exponentiation and
4815 ! subsequent NaNs and INFs in energy calculation.
4816 ! Find the largest exponent
4820 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4824 !d print *,'it=',it,' emin=',emin
4826 ! Compute the contribution to SC energy and derivatives
4831 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
4832 if(adexp.ne.adexp) adexp=1.0
4835 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4837 !d print *,'j=',j,' expfac=',expfac
4838 escloc_i=escloc_i+expfac
4840 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4844 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
4845 +gaussc(k,2,j,it))*expfac
4852 dersc(1)=dersc(1)/cos(theti)**2
4853 ddersc(1)=ddersc(1)/cos(theti)**2
4856 escloci=-(dlog(escloc_i)-emin)
4858 dersc(j)=dersc(j)/escloc_i
4862 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4866 end subroutine enesc
4867 !-----------------------------------------------------------------------------
4868 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4871 ! implicit real*8 (a-h,o-z)
4872 ! include 'DIMENSIONS'
4873 ! include 'COMMON.GEO'
4874 ! include 'COMMON.LOCAL'
4875 ! include 'COMMON.IOUNITS'
4876 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4877 real(kind=8),dimension(3) :: x,z,dersc
4878 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
4879 real(kind=8),dimension(nlobit) :: contr !(maxlob)
4880 real(kind=8) :: escloci,dersc12,emin
4883 integer :: j,k,l !el,it,nlobit
4884 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
4894 z(k)=x(k)-censc(k,j,it)
4900 Axk=Axk+gaussc(l,k,j,it)*z(l)
4906 expfac=expfac+Ax(k,j)*z(k)
4911 ! As in the case of ebend, we want to avoid underflows in exponentiation and
4912 ! subsequent NaNs and INFs in energy calculation.
4913 ! Find the largest exponent
4916 if (emin.gt.contr(j)) emin=contr(j)
4920 ! Compute the contribution to SC energy and derivatives
4924 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4925 escloc_i=escloc_i+expfac
4927 dersc(k)=dersc(k)+Ax(k,j)*expfac
4929 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
4930 +gaussc(1,2,j,it))*expfac
4934 dersc(1)=dersc(1)/cos(theti)**2
4935 dersc12=dersc12/cos(theti)**2
4936 escloci=-(dlog(escloc_i)-emin)
4938 dersc(j)=dersc(j)/escloc_i
4940 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4942 end subroutine enesc_bound
4944 !-----------------------------------------------------------------------------
4945 subroutine esc(escloc)
4946 ! Calculate the local energy of a side chain and its derivatives in the
4947 ! corresponding virtual-bond valence angles THETA and the spherical angles
4948 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
4949 ! added by Urszula Kozlowska. 07/11/2007
4952 ! implicit real*8 (a-h,o-z)
4953 ! include 'DIMENSIONS'
4954 ! include 'COMMON.GEO'
4955 ! include 'COMMON.LOCAL'
4956 ! include 'COMMON.VAR'
4957 ! include 'COMMON.SCROT'
4958 ! include 'COMMON.INTERACT'
4959 ! include 'COMMON.DERIV'
4960 ! include 'COMMON.CHAIN'
4961 ! include 'COMMON.IOUNITS'
4962 ! include 'COMMON.NAMES'
4963 ! include 'COMMON.FFIELD'
4964 ! include 'COMMON.CONTROL'
4965 ! include 'COMMON.VECTORS'
4966 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
4967 real(kind=8),dimension(65) :: x
4968 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
4969 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
4970 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
4971 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
4972 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
4974 integer :: i,j,k !el,it,nlobit
4975 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
4976 !el real(kind=8) :: time11,time12,time112,theti
4977 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4978 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
4979 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
4980 sumene1x,sumene2x,sumene3x,sumene4x,&
4981 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
4984 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
4985 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
4988 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
4992 do i=loc_start,loc_end
4993 if (itype(i).eq.ntyp1) cycle
4994 costtab(i+1) =dcos(theta(i+1))
4995 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4996 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4997 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4998 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4999 cosfac=dsqrt(cosfac2)
5000 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5001 sinfac=dsqrt(sinfac2)
5003 if (it.eq.10) goto 1
5005 ! Compute the axes of tghe local cartesian coordinates system; store in
5006 ! x_prime, y_prime and z_prime
5013 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5014 ! & dc_norm(3,i+nres)
5016 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5017 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5020 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5023 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
5024 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
5025 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
5026 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5027 ! & " xy",scalar(x_prime(1),y_prime(1)),
5028 ! & " xz",scalar(x_prime(1),z_prime(1)),
5029 ! & " yy",scalar(y_prime(1),y_prime(1)),
5030 ! & " yz",scalar(y_prime(1),z_prime(1)),
5031 ! & " zz",scalar(z_prime(1),z_prime(1))
5033 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5034 ! to local coordinate system. Store in xx, yy, zz.
5040 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5041 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5042 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5049 ! Compute the energy of the ith side cbain
5051 ! write (2,*) "xx",xx," yy",yy," zz",zz
5054 x(j) = sc_parmin(j,it)
5057 !c diagnostics - remove later
5059 yy1 = dsin(alph(2))*dcos(omeg(2))
5060 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5061 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
5062 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
5064 !," --- ", xx_w,yy_w,zz_w
5067 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
5068 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
5070 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
5071 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
5073 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
5074 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
5075 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
5076 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
5077 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
5079 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
5080 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
5081 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
5082 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
5083 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
5085 dsc_i = 0.743d0+x(61)
5087 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5088 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5089 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5090 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5091 s1=(1+x(63))/(0.1d0 + dscp1)
5092 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5093 s2=(1+x(65))/(0.1d0 + dscp2)
5094 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5095 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
5096 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5097 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5099 ! & dscp1,dscp2,sumene
5100 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5101 escloc = escloc + sumene
5102 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5107 ! This section to check the numerical derivatives of the energy of ith side
5108 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5109 ! #define DEBUG in the code to turn it on.
5111 write (2,*) "sumene =",sumene
5115 write (2,*) xx,yy,zz
5116 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5117 de_dxx_num=(sumenep-sumene)/aincr
5119 write (2,*) "xx+ sumene from enesc=",sumenep
5122 write (2,*) xx,yy,zz
5123 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5124 de_dyy_num=(sumenep-sumene)/aincr
5126 write (2,*) "yy+ sumene from enesc=",sumenep
5129 write (2,*) xx,yy,zz
5130 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5131 de_dzz_num=(sumenep-sumene)/aincr
5133 write (2,*) "zz+ sumene from enesc=",sumenep
5134 costsave=cost2tab(i+1)
5135 sintsave=sint2tab(i+1)
5136 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5137 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5138 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5139 de_dt_num=(sumenep-sumene)/aincr
5140 write (2,*) " t+ sumene from enesc=",sumenep
5141 cost2tab(i+1)=costsave
5142 sint2tab(i+1)=sintsave
5143 ! End of diagnostics section.
5146 ! Compute the gradient of esc
5148 ! zz=zz*dsign(1.0,dfloat(itype(i)))
5149 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5150 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5151 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5152 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5153 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5154 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5155 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5156 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5157 pom1=(sumene3*sint2tab(i+1)+sumene1) &
5158 *(pom_s1/dscp1+pom_s16*dscp1**4)
5159 pom2=(sumene4*cost2tab(i+1)+sumene2) &
5160 *(pom_s2/dscp2+pom_s26*dscp2**4)
5161 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5162 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
5163 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
5165 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5166 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
5167 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
5169 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
5170 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
5173 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5176 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5177 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
5178 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
5180 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5181 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
5182 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
5183 +x(59)*zz**2 +x(60)*xx*zz
5184 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
5185 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
5188 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5191 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
5192 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
5193 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
5194 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
5195 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
5196 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
5197 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
5198 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5200 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5203 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
5204 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
5205 +pom1*pom_dt1+pom2*pom_dt2
5207 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5211 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5212 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5213 cosfac2xx=cosfac2*xx
5214 sinfac2yy=sinfac2*yy
5216 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
5218 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
5220 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5221 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5222 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5223 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5224 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5225 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5226 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5227 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5228 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5229 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5233 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
5234 *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5235 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
5236 *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5239 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5240 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5241 dZZ_XYZ(k)=vbld_inv(i+nres)* &
5242 (z_prime(k)-zz*dC_norm(k,i+nres))
5244 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5245 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5249 dXX_Ctab(k,i)=dXX_Ci(k)
5250 dXX_C1tab(k,i)=dXX_Ci1(k)
5251 dYY_Ctab(k,i)=dYY_Ci(k)
5252 dYY_C1tab(k,i)=dYY_Ci1(k)
5253 dZZ_Ctab(k,i)=dZZ_Ci(k)
5254 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5255 dXX_XYZtab(k,i)=dXX_XYZ(k)
5256 dYY_XYZtab(k,i)=dYY_XYZ(k)
5257 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5261 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5262 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5263 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5264 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
5265 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5267 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5268 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5269 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
5270 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5271 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
5272 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5273 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
5274 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5276 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5277 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5279 ! to check gradient call subroutine check_grad
5285 !-----------------------------------------------------------------------------
5286 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
5288 real(kind=8),dimension(65) :: x
5289 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
5290 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5292 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
5293 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
5295 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
5296 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
5298 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
5299 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
5300 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
5301 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
5302 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
5304 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
5305 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
5306 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
5307 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
5308 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
5310 dsc_i = 0.743d0+x(61)
5312 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5313 *(xx*cost2+yy*sint2))
5314 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5315 *(xx*cost2-yy*sint2))
5316 s1=(1+x(63))/(0.1d0 + dscp1)
5317 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5318 s2=(1+x(65))/(0.1d0 + dscp2)
5319 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5320 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
5321 + (sumene4*cost2 +sumene2)*(s2+s2_6)
5326 !-----------------------------------------------------------------------------
5327 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5329 ! This procedure calculates two-body contact function g(rij) and its derivative:
5332 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5335 ! where x=(rij-r0ij)/delta
5337 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5340 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
5341 real(kind=8) :: x,x2,x4,delta
5345 if (x.lt.-1.0D0) then
5348 else if (x.le.1.0D0) then
5351 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5352 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5358 end subroutine gcont
5359 !-----------------------------------------------------------------------------
5360 subroutine splinthet(theti,delta,ss,ssder)
5361 ! implicit real*8 (a-h,o-z)
5362 ! include 'DIMENSIONS'
5363 ! include 'COMMON.VAR'
5364 ! include 'COMMON.GEO'
5365 real(kind=8) :: theti,delta,ss,ssder
5366 real(kind=8) :: thetup,thetlow
5369 if (theti.gt.pipol) then
5370 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5372 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5376 end subroutine splinthet
5377 !-----------------------------------------------------------------------------
5378 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5380 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
5381 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
5382 a1=fprim0*delta/(f1-f0)
5388 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5389 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5391 end subroutine spline1
5392 !-----------------------------------------------------------------------------
5393 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5395 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
5396 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
5401 a2=3*(f1x-f0x)-2*fprim0x*delta
5402 a3=fprim0x*delta-2*(f1x-f0x)
5403 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5405 end subroutine spline2
5406 !-----------------------------------------------------------------------------
5408 !-----------------------------------------------------------------------------
5409 subroutine etor(etors,edihcnstr)
5410 ! implicit real*8 (a-h,o-z)
5411 ! include 'DIMENSIONS'
5412 ! include 'COMMON.VAR'
5413 ! include 'COMMON.GEO'
5414 ! include 'COMMON.LOCAL'
5415 ! include 'COMMON.TORSION'
5416 ! include 'COMMON.INTERACT'
5417 ! include 'COMMON.DERIV'
5418 ! include 'COMMON.CHAIN'
5419 ! include 'COMMON.NAMES'
5420 ! include 'COMMON.IOUNITS'
5421 ! include 'COMMON.FFIELD'
5422 ! include 'COMMON.TORCNSTR'
5423 ! include 'COMMON.CONTROL'
5424 real(kind=8) :: etors,edihcnstr
5428 real(kind=8) :: phii,fac,etors_ii
5430 ! Set lprn=.true. for debugging
5434 do i=iphi_start,iphi_end
5436 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 &
5437 .or. itype(i).eq.ntyp1) cycle
5438 itori=itortyp(itype(i-2))
5439 itori1=itortyp(itype(i-1))
5442 ! Proline-Proline pair is a special case...
5443 if (itori.eq.3 .and. itori1.eq.3) then
5444 if (phii.gt.-dwapi3) then
5446 fac=1.0D0/(1.0D0-cosphi)
5447 etorsi=v1(1,3,3)*fac
5448 etorsi=etorsi+etorsi
5449 etors=etors+etorsi-v1(1,3,3)
5450 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5451 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5454 v1ij=v1(j+1,itori,itori1)
5455 v2ij=v2(j+1,itori,itori1)
5458 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5459 if (energy_dec) etors_ii=etors_ii+ &
5460 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5461 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5465 v1ij=v1(j,itori,itori1)
5466 v2ij=v2(j,itori,itori1)
5469 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5470 if (energy_dec) etors_ii=etors_ii+ &
5471 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5472 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5475 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5478 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5479 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
5480 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5481 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5482 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5484 ! 6/20/98 - dihedral angle constraints
5487 itori=idih_constr(i)
5490 if (difi.gt.drange(i)) then
5492 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5493 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5494 else if (difi.lt.-drange(i)) then
5496 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5497 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5499 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5500 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5502 ! write (iout,*) 'edihcnstr',edihcnstr
5505 !-----------------------------------------------------------------------------
5506 subroutine etor_d(etors_d)
5507 real(kind=8) :: etors_d
5510 end subroutine etor_d
5512 !-----------------------------------------------------------------------------
5513 subroutine etor(etors,edihcnstr)
5514 ! implicit real*8 (a-h,o-z)
5515 ! include 'DIMENSIONS'
5516 ! include 'COMMON.VAR'
5517 ! include 'COMMON.GEO'
5518 ! include 'COMMON.LOCAL'
5519 ! include 'COMMON.TORSION'
5520 ! include 'COMMON.INTERACT'
5521 ! include 'COMMON.DERIV'
5522 ! include 'COMMON.CHAIN'
5523 ! include 'COMMON.NAMES'
5524 ! include 'COMMON.IOUNITS'
5525 ! include 'COMMON.FFIELD'
5526 ! include 'COMMON.TORCNSTR'
5527 ! include 'COMMON.CONTROL'
5528 real(kind=8) :: etors,edihcnstr
5531 integer :: i,j,iblock,itori,itori1
5532 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
5533 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
5534 ! Set lprn=.true. for debugging
5538 do i=iphi_start,iphi_end
5539 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
5540 .or. itype(i-3).eq.ntyp1 &
5541 .or. itype(i).eq.ntyp1) cycle
5543 if (iabs(itype(i)).eq.20) then
5548 itori=itortyp(itype(i-2))
5549 itori1=itortyp(itype(i-1))
5552 ! Regular cosine and sine terms
5553 do j=1,nterm(itori,itori1,iblock)
5554 v1ij=v1(j,itori,itori1,iblock)
5555 v2ij=v2(j,itori,itori1,iblock)
5558 etors=etors+v1ij*cosphi+v2ij*sinphi
5559 if (energy_dec) etors_ii=etors_ii+ &
5560 v1ij*cosphi+v2ij*sinphi
5561 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5565 ! E = SUM ----------------------------------- - v1
5566 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5568 cosphi=dcos(0.5d0*phii)
5569 sinphi=dsin(0.5d0*phii)
5570 do j=1,nlor(itori,itori1,iblock)
5571 vl1ij=vlor1(j,itori,itori1)
5572 vl2ij=vlor2(j,itori,itori1)
5573 vl3ij=vlor3(j,itori,itori1)
5574 pom=vl2ij*cosphi+vl3ij*sinphi
5575 pom1=1.0d0/(pom*pom+1.0d0)
5576 etors=etors+vl1ij*pom1
5577 if (energy_dec) etors_ii=etors_ii+ &
5580 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5582 ! Subtract the constant term
5583 etors=etors-v0(itori,itori1,iblock)
5584 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5585 'etor',i,etors_ii-v0(itori,itori1,iblock)
5587 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5588 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
5589 (v1(j,itori,itori1,iblock),j=1,6),&
5590 (v2(j,itori,itori1,iblock),j=1,6)
5591 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5592 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5594 ! 6/20/98 - dihedral angle constraints
5596 ! do i=1,ndih_constr
5597 do i=idihconstr_start,idihconstr_end
5598 itori=idih_constr(i)
5600 difi=pinorm(phii-phi0(i))
5601 if (difi.gt.drange(i)) then
5603 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5604 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5605 else if (difi.lt.-drange(i)) then
5607 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5608 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5612 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5613 !d & rad2deg*phi0(i), rad2deg*drange(i),
5614 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5616 !d write (iout,*) 'edihcnstr',edihcnstr
5619 !-----------------------------------------------------------------------------
5620 subroutine etor_d(etors_d)
5621 ! 6/23/01 Compute double torsional energy
5622 ! implicit real*8 (a-h,o-z)
5623 ! include 'DIMENSIONS'
5624 ! include 'COMMON.VAR'
5625 ! include 'COMMON.GEO'
5626 ! include 'COMMON.LOCAL'
5627 ! include 'COMMON.TORSION'
5628 ! include 'COMMON.INTERACT'
5629 ! include 'COMMON.DERIV'
5630 ! include 'COMMON.CHAIN'
5631 ! include 'COMMON.NAMES'
5632 ! include 'COMMON.IOUNITS'
5633 ! include 'COMMON.FFIELD'
5634 ! include 'COMMON.TORCNSTR'
5635 real(kind=8) :: etors_d,etors_d_ii
5638 integer :: i,j,k,l,itori,itori1,itori2,iblock
5639 real(kind=8) :: phii,phii1,gloci1,gloci2,&
5640 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
5641 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
5642 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
5643 ! Set lprn=.true. for debugging
5647 ! write(iout,*) "a tu??"
5648 do i=iphid_start,iphid_end
5650 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
5651 .or. itype(i-3).eq.ntyp1 &
5652 .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5653 itori=itortyp(itype(i-2))
5654 itori1=itortyp(itype(i-1))
5655 itori2=itortyp(itype(i))
5661 if (iabs(itype(i+1)).eq.20) iblock=2
5663 ! Regular cosine and sine terms
5664 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5665 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5666 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5667 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5668 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5669 cosphi1=dcos(j*phii)
5670 sinphi1=dsin(j*phii)
5671 cosphi2=dcos(j*phii1)
5672 sinphi2=dsin(j*phii1)
5673 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
5674 v2cij*cosphi2+v2sij*sinphi2
5675 if (energy_dec) etors_d_ii=etors_d_ii+ &
5676 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
5677 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5678 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5680 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5682 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5683 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5684 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5685 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5686 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5687 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5688 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5689 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5690 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
5691 v1sdij*sinphi1p2+v2sdij*sinphi1m2
5692 if (energy_dec) etors_d_ii=etors_d_ii+ &
5693 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
5694 v1sdij*sinphi1p2+v2sdij*sinphi1m2
5695 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
5696 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5697 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
5698 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5701 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5702 'etor_d',i,etors_d_ii
5703 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5704 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5707 end subroutine etor_d
5709 !-----------------------------------------------------------------------------
5710 subroutine eback_sc_corr(esccor)
5711 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
5712 ! conformational states; temporarily implemented as differences
5713 ! between UNRES torsional potentials (dependent on three types of
5714 ! residues) and the torsional potentials dependent on all 20 types
5715 ! of residues computed from AM1 energy surfaces of terminally-blocked
5716 ! amino-acid residues.
5717 ! implicit real*8 (a-h,o-z)
5718 ! include 'DIMENSIONS'
5719 ! include 'COMMON.VAR'
5720 ! include 'COMMON.GEO'
5721 ! include 'COMMON.LOCAL'
5722 ! include 'COMMON.TORSION'
5723 ! include 'COMMON.SCCOR'
5724 ! include 'COMMON.INTERACT'
5725 ! include 'COMMON.DERIV'
5726 ! include 'COMMON.CHAIN'
5727 ! include 'COMMON.NAMES'
5728 ! include 'COMMON.IOUNITS'
5729 ! include 'COMMON.FFIELD'
5730 ! include 'COMMON.CONTROL'
5731 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
5734 integer :: i,interty,j,isccori,isccori1,intertyp
5735 ! Set lprn=.true. for debugging
5738 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5740 do i=itau_start,itau_end
5741 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5743 isccori=isccortyp(itype(i-2))
5744 isccori1=isccortyp(itype(i-1))
5746 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5748 do intertyp=1,3 !intertyp
5750 !c Added 09 May 2012 (Adasko)
5751 !c Intertyp means interaction type of backbone mainchain correlation:
5752 ! 1 = SC...Ca...Ca...Ca
5753 ! 2 = Ca...Ca...Ca...SC
5754 ! 3 = SC...Ca...Ca...SCi
5756 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. &
5757 (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or. &
5758 (itype(i-1).eq.ntyp1))) &
5759 .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) &
5760 .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1) &
5761 .or.(itype(i).eq.ntyp1))) &
5762 .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. &
5763 (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. &
5764 (itype(i-3).eq.ntyp1)))) cycle
5765 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5766 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1)) &
5768 do j=1,nterm_sccor(isccori,isccori1)
5769 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5770 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5771 cosphi=dcos(j*tauangle(intertyp,i))
5772 sinphi=dsin(j*tauangle(intertyp,i))
5773 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
5774 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5775 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5777 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
5778 'esccor',i,intertyp,esccor_ii
5779 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5780 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5782 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5783 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,&
5784 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
5785 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5786 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5791 end subroutine eback_sc_corr
5792 !-----------------------------------------------------------------------------
5793 subroutine multibody(ecorr)
5794 ! This subroutine calculates multi-body contributions to energy following
5795 ! the idea of Skolnick et al. If side chains I and J make a contact and
5796 ! at the same time side chains I+1 and J+1 make a contact, an extra
5797 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5798 ! implicit real*8 (a-h,o-z)
5799 ! include 'DIMENSIONS'
5800 ! include 'COMMON.IOUNITS'
5801 ! include 'COMMON.DERIV'
5802 ! include 'COMMON.INTERACT'
5803 ! include 'COMMON.CONTACTS'
5804 real(kind=8),dimension(3) :: gx,gx1
5806 real(kind=8) :: ecorr
5807 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
5808 ! Set lprn=.true. for debugging
5812 write (iout,'(a)') 'Contact function values:'
5814 write (iout,'(i2,20(1x,i2,f10.5))') &
5815 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5820 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
5821 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
5833 num_conti=num_cont(i)
5834 num_conti1=num_cont(i1)
5839 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5840 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5841 !d & ' ishift=',ishift
5842 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5843 ! The system gains extra energy.
5844 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5845 endif ! j1==j+-ishift
5853 end subroutine multibody
5854 !-----------------------------------------------------------------------------
5855 real(kind=8) function esccorr(i,j,k,l,jj,kk)
5856 ! implicit real*8 (a-h,o-z)
5857 ! include 'DIMENSIONS'
5858 ! include 'COMMON.IOUNITS'
5859 ! include 'COMMON.DERIV'
5860 ! include 'COMMON.INTERACT'
5861 ! include 'COMMON.CONTACTS'
5862 real(kind=8),dimension(3) :: gx,gx1
5864 integer :: i,j,k,l,jj,kk,m,ll
5865 real(kind=8) :: eij,ekl
5869 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5870 ! Calculate the multi-body contribution to energy.
5871 ! Calculate multi-body contributions to the gradient.
5872 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5873 !d & k,l,(gacont(m,kk,k),m=1,3)
5875 gx(m) =ekl*gacont(m,jj,i)
5876 gx1(m)=eij*gacont(m,kk,k)
5877 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5878 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5879 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5880 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5884 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5889 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5894 end function esccorr
5895 !-----------------------------------------------------------------------------
5896 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5897 ! This subroutine calculates multi-body contributions to hydrogen-bonding
5898 ! implicit real*8 (a-h,o-z)
5899 ! include 'DIMENSIONS'
5900 ! include 'COMMON.IOUNITS'
5903 ! integer :: maxconts !max_cont=maxconts =nres/4
5904 integer,parameter :: max_dim=26
5905 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5906 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
5907 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
5908 !el common /przechowalnia/ zapas
5909 integer :: status(MPI_STATUS_SIZE)
5910 integer,dimension((nres/4)*2) :: req !maxconts*2
5911 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
5913 ! include 'COMMON.SETUP'
5914 ! include 'COMMON.FFIELD'
5915 ! include 'COMMON.DERIV'
5916 ! include 'COMMON.INTERACT'
5917 ! include 'COMMON.CONTACTS'
5918 ! include 'COMMON.CONTROL'
5919 ! include 'COMMON.LOCAL'
5920 real(kind=8),dimension(3) :: gx,gx1
5921 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
5922 logical :: lprn,ldone
5924 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
5925 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
5927 ! Set lprn=.true. for debugging
5931 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
5934 if (nfgtasks.le.1) goto 30
5936 write (iout,'(a)') 'Contact function values before RECEIVE:'
5938 write (iout,'(2i3,50(1x,i2,f5.2))') &
5939 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
5944 do i=1,ntask_cont_from
5947 do i=1,ntask_cont_to
5950 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5952 ! Make the list of contacts to send to send to other procesors
5953 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5955 do i=iturn3_start,iturn3_end
5956 ! write (iout,*) "make contact list turn3",i," num_cont",
5958 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5960 do i=iturn4_start,iturn4_end
5961 ! write (iout,*) "make contact list turn4",i," num_cont",
5963 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5967 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
5969 do j=1,num_cont_hb(i)
5972 iproc=iint_sent_local(k,jjc,ii)
5973 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5974 if (iproc.gt.0) then
5975 ncont_sent(iproc)=ncont_sent(iproc)+1
5976 nn=ncont_sent(iproc)
5978 zapas(2,nn,iproc)=jjc
5979 zapas(3,nn,iproc)=facont_hb(j,i)
5980 zapas(4,nn,iproc)=ees0p(j,i)
5981 zapas(5,nn,iproc)=ees0m(j,i)
5982 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5983 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5984 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5985 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5986 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5987 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5988 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5989 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5990 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5991 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5992 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
5993 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
5994 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
5995 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
5996 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
5997 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
5998 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
5999 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6000 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6001 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6002 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6009 "Numbers of contacts to be sent to other processors",&
6010 (ncont_sent(i),i=1,ntask_cont_to)
6011 write (iout,*) "Contacts sent"
6012 do ii=1,ntask_cont_to
6014 iproc=itask_cont_to(ii)
6015 write (iout,*) nn," contacts to processor",iproc,&
6016 " of CONT_TO_COMM group"
6018 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6026 CorrelID1=nfgtasks+fg_rank+1
6028 ! Receive the numbers of needed contacts from other processors
6029 do ii=1,ntask_cont_from
6030 iproc=itask_cont_from(ii)
6032 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
6033 FG_COMM,req(ireq),IERR)
6035 ! write (iout,*) "IRECV ended"
6037 ! Send the number of contacts needed by other processors
6038 do ii=1,ntask_cont_to
6039 iproc=itask_cont_to(ii)
6041 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
6042 FG_COMM,req(ireq),IERR)
6044 ! write (iout,*) "ISEND ended"
6045 ! write (iout,*) "number of requests (nn)",ireq
6048 call MPI_Waitall(ireq,req,status_array,ierr)
6050 ! & "Numbers of contacts to be received from other processors",
6051 ! & (ncont_recv(i),i=1,ntask_cont_from)
6055 do ii=1,ntask_cont_from
6056 iproc=itask_cont_from(ii)
6058 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
6059 ! & " of CONT_TO_COMM group"
6063 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
6064 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6065 ! write (iout,*) "ireq,req",ireq,req(ireq)
6068 ! Send the contacts to processors that need them
6069 do ii=1,ntask_cont_to
6070 iproc=itask_cont_to(ii)
6072 ! write (iout,*) nn," contacts to processor",iproc,
6073 ! & " of CONT_TO_COMM group"
6076 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
6077 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6078 ! write (iout,*) "ireq,req",ireq,req(ireq)
6080 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6084 ! write (iout,*) "number of requests (contacts)",ireq
6085 ! write (iout,*) "req",(req(i),i=1,4)
6088 call MPI_Waitall(ireq,req,status_array,ierr)
6089 do iii=1,ntask_cont_from
6090 iproc=itask_cont_from(iii)
6093 write (iout,*) "Received",nn," contacts from processor",iproc,&
6094 " of CONT_FROM_COMM group"
6097 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6102 ii=zapas_recv(1,i,iii)
6103 ! Flag the received contacts to prevent double-counting
6104 jj=-zapas_recv(2,i,iii)
6105 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6107 nnn=num_cont_hb(ii)+1
6110 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6111 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6112 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6113 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6114 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6115 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6116 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6117 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6118 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6119 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6120 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6121 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6122 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6123 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6124 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6125 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6126 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6127 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6128 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6129 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6130 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6131 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6132 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6133 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6138 write (iout,'(a)') 'Contact function values after receive:'
6140 write (iout,'(2i3,50(1x,i3,f5.2))') &
6141 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6149 write (iout,'(a)') 'Contact function values:'
6151 write (iout,'(2i3,50(1x,i3,f5.2))') &
6152 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6158 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6159 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6160 ! Remove the loop below after debugging !!!
6167 ! Calculate the local-electrostatic correlation terms
6168 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6170 num_conti=num_cont_hb(i)
6171 num_conti1=num_cont_hb(i+1)
6178 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
6179 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
6180 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
6181 .or. j.lt.0 .and. j1.gt.0) .and. &
6182 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6183 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6184 ! The system gains extra energy.
6185 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6186 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
6187 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6189 else if (j1.eq.j) then
6190 ! Contacts I-J and I-(J+1) occur simultaneously.
6191 ! The system loses extra energy.
6192 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6197 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6198 ! & ' jj=',jj,' kk=',kk
6200 ! Contacts I-J and (I+1)-J occur simultaneously.
6201 ! The system loses extra energy.
6202 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6208 end subroutine multibody_hb
6209 !-----------------------------------------------------------------------------
6210 subroutine add_hb_contact(ii,jj,itask)
6211 ! implicit real*8 (a-h,o-z)
6212 ! include "DIMENSIONS"
6213 ! include "COMMON.IOUNITS"
6214 ! include "COMMON.CONTACTS"
6215 ! integer,parameter :: maxconts=nres/4
6216 integer,parameter :: max_dim=26
6217 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6218 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
6219 ! common /przechowalnia/ zapas
6220 integer :: i,j,ii,jj,iproc,nn,jjc
6221 integer,dimension(4) :: itask
6222 ! write (iout,*) "itask",itask
6225 if (iproc.gt.0) then
6226 do j=1,num_cont_hb(ii)
6228 ! write (iout,*) "i",ii," j",jj," jjc",jjc
6230 ncont_sent(iproc)=ncont_sent(iproc)+1
6231 nn=ncont_sent(iproc)
6232 zapas(1,nn,iproc)=ii
6233 zapas(2,nn,iproc)=jjc
6234 zapas(3,nn,iproc)=facont_hb(j,ii)
6235 zapas(4,nn,iproc)=ees0p(j,ii)
6236 zapas(5,nn,iproc)=ees0m(j,ii)
6237 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6238 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6239 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6240 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6241 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6242 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6243 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6244 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6245 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6246 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6247 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6248 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6249 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6250 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6251 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6252 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6253 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6254 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6255 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6256 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6257 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6264 end subroutine add_hb_contact
6265 !-----------------------------------------------------------------------------
6266 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
6267 ! This subroutine calculates multi-body contributions to hydrogen-bonding
6268 ! implicit real*8 (a-h,o-z)
6269 ! include 'DIMENSIONS'
6270 ! include 'COMMON.IOUNITS'
6271 integer,parameter :: max_dim=70
6274 ! integer :: maxconts !max_cont=maxconts=nres/4
6275 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6276 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
6277 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6278 ! common /przechowalnia/ zapas
6279 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
6280 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
6283 ! include 'COMMON.SETUP'
6284 ! include 'COMMON.FFIELD'
6285 ! include 'COMMON.DERIV'
6286 ! include 'COMMON.LOCAL'
6287 ! include 'COMMON.INTERACT'
6288 ! include 'COMMON.CONTACTS'
6289 ! include 'COMMON.CHAIN'
6290 ! include 'COMMON.CONTROL'
6291 real(kind=8),dimension(3) :: gx,gx1
6292 integer,dimension(nres) :: num_cont_hb_old
6293 logical :: lprn,ldone
6294 !EL double precision eello4,eello5,eelo6,eello_turn6
6295 !EL external eello4,eello5,eello6,eello_turn6
6297 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
6298 j1,jp1,i1,num_conti1
6299 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
6300 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
6302 ! Set lprn=.true. for debugging
6307 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
6309 num_cont_hb_old(i)=num_cont_hb(i)
6313 if (nfgtasks.le.1) goto 30
6315 write (iout,'(a)') 'Contact function values before RECEIVE:'
6317 write (iout,'(2i3,50(1x,i2,f5.2))') &
6318 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6323 do i=1,ntask_cont_from
6326 do i=1,ntask_cont_to
6329 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6331 ! Make the list of contacts to send to send to other procesors
6332 do i=iturn3_start,iturn3_end
6333 ! write (iout,*) "make contact list turn3",i," num_cont",
6335 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6337 do i=iturn4_start,iturn4_end
6338 ! write (iout,*) "make contact list turn4",i," num_cont",
6340 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6344 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
6346 do j=1,num_cont_hb(i)
6349 iproc=iint_sent_local(k,jjc,ii)
6350 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6351 if (iproc.ne.0) then
6352 ncont_sent(iproc)=ncont_sent(iproc)+1
6353 nn=ncont_sent(iproc)
6355 zapas(2,nn,iproc)=jjc
6356 zapas(3,nn,iproc)=d_cont(j,i)
6360 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6365 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6373 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6384 "Numbers of contacts to be sent to other processors",&
6385 (ncont_sent(i),i=1,ntask_cont_to)
6386 write (iout,*) "Contacts sent"
6387 do ii=1,ntask_cont_to
6389 iproc=itask_cont_to(ii)
6390 write (iout,*) nn," contacts to processor",iproc,&
6391 " of CONT_TO_COMM group"
6393 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6401 CorrelID1=nfgtasks+fg_rank+1
6403 ! Receive the numbers of needed contacts from other processors
6404 do ii=1,ntask_cont_from
6405 iproc=itask_cont_from(ii)
6407 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
6408 FG_COMM,req(ireq),IERR)
6410 ! write (iout,*) "IRECV ended"
6412 ! Send the number of contacts needed by other processors
6413 do ii=1,ntask_cont_to
6414 iproc=itask_cont_to(ii)
6416 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
6417 FG_COMM,req(ireq),IERR)
6419 ! write (iout,*) "ISEND ended"
6420 ! write (iout,*) "number of requests (nn)",ireq
6423 call MPI_Waitall(ireq,req,status_array,ierr)
6425 ! & "Numbers of contacts to be received from other processors",
6426 ! & (ncont_recv(i),i=1,ntask_cont_from)
6430 do ii=1,ntask_cont_from
6431 iproc=itask_cont_from(ii)
6433 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
6434 ! & " of CONT_TO_COMM group"
6438 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
6439 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6440 ! write (iout,*) "ireq,req",ireq,req(ireq)
6443 ! Send the contacts to processors that need them
6444 do ii=1,ntask_cont_to
6445 iproc=itask_cont_to(ii)
6447 ! write (iout,*) nn," contacts to processor",iproc,
6448 ! & " of CONT_TO_COMM group"
6451 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
6452 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6453 ! write (iout,*) "ireq,req",ireq,req(ireq)
6455 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6459 ! write (iout,*) "number of requests (contacts)",ireq
6460 ! write (iout,*) "req",(req(i),i=1,4)
6463 call MPI_Waitall(ireq,req,status_array,ierr)
6464 do iii=1,ntask_cont_from
6465 iproc=itask_cont_from(iii)
6468 write (iout,*) "Received",nn," contacts from processor",iproc,&
6469 " of CONT_FROM_COMM group"
6472 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6477 ii=zapas_recv(1,i,iii)
6478 ! Flag the received contacts to prevent double-counting
6479 jj=-zapas_recv(2,i,iii)
6480 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6482 nnn=num_cont_hb(ii)+1
6485 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6489 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6494 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6502 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6511 write (iout,'(a)') 'Contact function values after receive:'
6513 write (iout,'(2i3,50(1x,i3,5f6.3))') &
6514 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
6515 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6522 write (iout,'(a)') 'Contact function values:'
6524 write (iout,'(2i3,50(1x,i2,5f6.3))') &
6525 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
6526 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6533 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6534 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6535 ! Remove the loop below after debugging !!!
6542 ! Calculate the dipole-dipole interaction energies
6543 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6544 do i=iatel_s,iatel_e+1
6545 num_conti=num_cont_hb(i)
6554 ! Calculate the local-electrostatic correlation terms
6555 ! write (iout,*) "gradcorr5 in eello5 before loop"
6557 ! write (iout,'(i5,3f10.5)')
6558 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6560 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6561 ! write (iout,*) "corr loop i",i
6563 num_conti=num_cont_hb(i)
6564 num_conti1=num_cont_hb(i+1)
6571 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6572 ! & ' jj=',jj,' kk=',kk
6573 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
6574 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
6575 .or. j.lt.0 .and. j1.gt.0) .and. &
6576 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6577 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6578 ! The system gains extra energy.
6580 sqd1=dsqrt(d_cont(jj,i))
6581 sqd2=dsqrt(d_cont(kk,i1))
6582 sred_geom = sqd1*sqd2
6583 IF (sred_geom.lt.cutoff_corr) THEN
6584 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
6586 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6587 !d & ' jj=',jj,' kk=',kk
6588 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6589 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6591 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6592 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6595 !d write (iout,*) 'sred_geom=',sred_geom,
6596 !d & ' ekont=',ekont,' fprim=',fprimcont,
6597 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6598 !d write (iout,*) "g_contij",g_contij
6599 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6600 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6601 call calc_eello(i,jp,i+1,jp1,jj,kk)
6602 if (wcorr4.gt.0.0d0) &
6603 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6604 if (energy_dec.and.wcorr4.gt.0.0d0) &
6605 write (iout,'(a6,4i5,0pf7.3)') &
6606 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6607 ! write (iout,*) "gradcorr5 before eello5"
6609 ! write (iout,'(i5,3f10.5)')
6610 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6612 if (wcorr5.gt.0.0d0) &
6613 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6614 ! write (iout,*) "gradcorr5 after eello5"
6616 ! write (iout,'(i5,3f10.5)')
6617 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6619 if (energy_dec.and.wcorr5.gt.0.0d0) &
6620 write (iout,'(a6,4i5,0pf7.3)') &
6621 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6622 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6623 !d write(2,*)'ijkl',i,jp,i+1,jp1
6624 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
6625 .or. wturn6.eq.0.0d0))then
6626 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6627 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6628 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
6629 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6630 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6631 !d & 'ecorr6=',ecorr6
6632 !d write (iout,'(4e15.5)') sred_geom,
6633 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6634 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6635 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6636 else if (wturn6.gt.0.0d0 &
6637 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6638 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6639 eturn6=eturn6+eello_turn6(i,jj,kk)
6640 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
6641 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6642 !d write (2,*) 'multibody_eello:eturn6',eturn6
6651 num_cont_hb(i)=num_cont_hb_old(i)
6653 ! write (iout,*) "gradcorr5 in eello5"
6655 ! write (iout,'(i5,3f10.5)')
6656 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6659 end subroutine multibody_eello
6660 !-----------------------------------------------------------------------------
6661 subroutine add_hb_contact_eello(ii,jj,itask)
6662 ! implicit real*8 (a-h,o-z)
6663 ! include "DIMENSIONS"
6664 ! include "COMMON.IOUNITS"
6665 ! include "COMMON.CONTACTS"
6666 ! integer,parameter :: maxconts=nres/4
6667 integer,parameter :: max_dim=70
6668 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
6669 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6670 ! common /przechowalnia/ zapas
6672 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
6673 integer,dimension(4) ::itask
6674 ! write (iout,*) "itask",itask
6677 if (iproc.gt.0) then
6678 do j=1,num_cont_hb(ii)
6680 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6682 ncont_sent(iproc)=ncont_sent(iproc)+1
6683 nn=ncont_sent(iproc)
6684 zapas(1,nn,iproc)=ii
6685 zapas(2,nn,iproc)=jjc
6686 zapas(3,nn,iproc)=d_cont(j,ii)
6690 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6695 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6703 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6714 end subroutine add_hb_contact_eello
6715 !-----------------------------------------------------------------------------
6716 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6717 ! implicit real*8 (a-h,o-z)
6718 ! include 'DIMENSIONS'
6719 ! include 'COMMON.IOUNITS'
6720 ! include 'COMMON.DERIV'
6721 ! include 'COMMON.INTERACT'
6722 ! include 'COMMON.CONTACTS'
6723 real(kind=8),dimension(3) :: gx,gx1
6726 integer :: i,j,k,l,jj,kk,ll
6727 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
6728 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
6729 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl
6739 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6740 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6741 ! Following 4 lines for diagnostics.
6746 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6747 ! & 'Contacts ',i,j,
6748 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6749 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6751 ! Calculate the multi-body contribution to energy.
6752 ! ecorr=ecorr+ekont*ees
6753 ! Calculate multi-body contributions to the gradient.
6754 coeffpees0pij=coeffp*ees0pij
6755 coeffmees0mij=coeffm*ees0mij
6756 coeffpees0pkl=coeffp*ees0pkl
6757 coeffmees0mkl=coeffm*ees0mkl
6759 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6760 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
6761 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
6762 coeffmees0mkl*gacontm_hb1(ll,jj,i))
6763 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
6764 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
6765 coeffmees0mkl*gacontm_hb2(ll,jj,i))
6766 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6767 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
6768 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
6769 coeffmees0mij*gacontm_hb1(ll,kk,k))
6770 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
6771 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
6772 coeffmees0mij*gacontm_hb2(ll,kk,k))
6773 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
6774 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
6775 coeffmees0mkl*gacontm_hb3(ll,jj,i))
6776 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6777 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6778 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
6779 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
6780 coeffmees0mij*gacontm_hb3(ll,kk,k))
6781 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6782 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6783 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6788 !grad gradcorr(ll,m)=gradcorr(ll,m)+
6789 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
6790 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6791 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6796 !grad gradcorr(ll,m)=gradcorr(ll,m)+
6797 !grad & ees*eij*gacont_hbr(ll,kk,k)-
6798 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6799 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6802 ! write (iout,*) "ehbcorr",ekont*ees
6805 end function ehbcorr
6807 !-----------------------------------------------------------------------------
6808 subroutine dipole(i,j,jj)
6809 ! implicit real*8 (a-h,o-z)
6810 ! include 'DIMENSIONS'
6811 ! include 'COMMON.IOUNITS'
6812 ! include 'COMMON.CHAIN'
6813 ! include 'COMMON.FFIELD'
6814 ! include 'COMMON.DERIV'
6815 ! include 'COMMON.INTERACT'
6816 ! include 'COMMON.CONTACTS'
6817 ! include 'COMMON.TORSION'
6818 ! include 'COMMON.VAR'
6819 ! include 'COMMON.GEO'
6820 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
6821 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
6822 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
6824 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
6825 allocate(dipderx(3,5,4,maxconts,nres))
6828 iti1 = itortyp(itype(i+1))
6829 if (j.lt.nres-1) then
6830 itj1 = itortyp(itype(j+1))
6835 dipi(iii,1)=Ub2(iii,i)
6836 dipderi(iii)=Ub2der(iii,i)
6837 dipi(iii,2)=b1(iii,iti1)
6838 dipj(iii,1)=Ub2(iii,j)
6839 dipderj(iii)=Ub2der(iii,j)
6840 dipj(iii,2)=b1(iii,itj1)
6844 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6847 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6854 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
6858 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6863 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6864 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6866 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6868 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6870 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6873 end subroutine dipole
6875 !-----------------------------------------------------------------------------
6876 subroutine calc_eello(i,j,k,l,jj,kk)
6878 ! This subroutine computes matrices and vectors needed to calculate
6879 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
6882 ! implicit real*8 (a-h,o-z)
6883 ! include 'DIMENSIONS'
6884 ! include 'COMMON.IOUNITS'
6885 ! include 'COMMON.CHAIN'
6886 ! include 'COMMON.DERIV'
6887 ! include 'COMMON.INTERACT'
6888 ! include 'COMMON.CONTACTS'
6889 ! include 'COMMON.TORSION'
6890 ! include 'COMMON.VAR'
6891 ! include 'COMMON.GEO'
6892 ! include 'COMMON.FFIELD'
6893 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
6894 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
6895 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
6898 !el common /kutas/ lprn
6899 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6900 !d & ' jj=',jj,' kk=',kk
6901 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6902 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6903 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6906 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6907 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6910 call transpose2(aa1(1,1),aa1t(1,1))
6911 call transpose2(aa2(1,1),aa2t(1,1))
6914 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
6915 aa1tder(1,1,lll,kkk))
6916 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
6917 aa2tder(1,1,lll,kkk))
6921 ! parallel orientation of the two CA-CA-CA frames.
6923 iti=itortyp(itype(i))
6927 itk1=itortyp(itype(k+1))
6928 itj=itortyp(itype(j))
6929 if (l.lt.nres-1) then
6930 itl1=itortyp(itype(l+1))
6934 ! A1 kernel(j+1) A2T
6936 !d write (iout,'(3f10.5,5x,3f10.5)')
6937 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6939 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
6940 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
6941 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6942 ! Following matrices are needed only for 6-th order cumulants
6943 IF (wcorr6.gt.0.0d0) THEN
6944 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
6945 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
6946 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6947 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
6948 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
6949 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
6950 ADtEAderx(1,1,1,1,1,1))
6952 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
6953 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
6954 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
6955 ADtEA1derx(1,1,1,1,1,1))
6957 ! End 6-th order cumulants
6960 !d write (2,*) 'In calc_eello6'
6962 !d write (2,*) 'iii=',iii
6964 !d write (2,*) 'kkk=',kkk
6966 !d write (2,'(3(2f10.5),5x)')
6967 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6972 call transpose2(EUgder(1,1,k),auxmat(1,1))
6973 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6974 call transpose2(EUg(1,1,k),auxmat(1,1))
6975 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6976 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6980 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
6981 EAEAderx(1,1,lll,kkk,iii,1))
6985 ! A1T kernel(i+1) A2
6986 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
6987 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
6988 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6989 ! Following matrices are needed only for 6-th order cumulants
6990 IF (wcorr6.gt.0.0d0) THEN
6991 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
6992 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
6993 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6994 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
6995 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
6996 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
6997 ADtEAderx(1,1,1,1,1,2))
6998 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
6999 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
7000 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
7001 ADtEA1derx(1,1,1,1,1,2))
7003 ! End 6-th order cumulants
7004 call transpose2(EUgder(1,1,l),auxmat(1,1))
7005 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7006 call transpose2(EUg(1,1,l),auxmat(1,1))
7007 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7008 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7012 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7013 EAEAderx(1,1,lll,kkk,iii,2))
7018 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7019 ! They are needed only when the fifth- or the sixth-order cumulants are
7021 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7022 call transpose2(AEA(1,1,1),auxmat(1,1))
7023 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7024 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7025 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7026 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7027 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7028 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7029 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7030 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7031 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7032 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7033 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7034 call transpose2(AEA(1,1,2),auxmat(1,1))
7035 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7036 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7037 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7038 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7039 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7040 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7041 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7042 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7043 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7044 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7045 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7046 ! Calculate the Cartesian derivatives of the vectors.
7050 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7051 call matvec2(auxmat(1,1),b1(1,iti),&
7052 AEAb1derx(1,lll,kkk,iii,1,1))
7053 call matvec2(auxmat(1,1),Ub2(1,i),&
7054 AEAb2derx(1,lll,kkk,iii,1,1))
7055 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
7056 AEAb1derx(1,lll,kkk,iii,2,1))
7057 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
7058 AEAb2derx(1,lll,kkk,iii,2,1))
7059 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7060 call matvec2(auxmat(1,1),b1(1,itj),&
7061 AEAb1derx(1,lll,kkk,iii,1,2))
7062 call matvec2(auxmat(1,1),Ub2(1,j),&
7063 AEAb2derx(1,lll,kkk,iii,1,2))
7064 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
7065 AEAb1derx(1,lll,kkk,iii,2,2))
7066 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
7067 AEAb2derx(1,lll,kkk,iii,2,2))
7074 ! Antiparallel orientation of the two CA-CA-CA frames.
7076 iti=itortyp(itype(i))
7080 itk1=itortyp(itype(k+1))
7081 itl=itortyp(itype(l))
7082 itj=itortyp(itype(j))
7083 if (j.lt.nres-1) then
7084 itj1=itortyp(itype(j+1))
7088 ! A2 kernel(j-1)T A1T
7089 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7090 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
7091 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7092 ! Following matrices are needed only for 6-th order cumulants
7093 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
7094 j.eq.i+4 .and. l.eq.i+3)) THEN
7095 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7096 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
7097 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7098 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7099 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
7100 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
7101 ADtEAderx(1,1,1,1,1,1))
7102 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7103 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
7104 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
7105 ADtEA1derx(1,1,1,1,1,1))
7107 ! End 6-th order cumulants
7108 call transpose2(EUgder(1,1,k),auxmat(1,1))
7109 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7110 call transpose2(EUg(1,1,k),auxmat(1,1))
7111 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7112 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7116 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7117 EAEAderx(1,1,lll,kkk,iii,1))
7121 ! A2T kernel(i+1)T A1
7122 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7123 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
7124 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7125 ! Following matrices are needed only for 6-th order cumulants
7126 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
7127 j.eq.i+4 .and. l.eq.i+3)) THEN
7128 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7129 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
7130 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7131 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7132 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
7133 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
7134 ADtEAderx(1,1,1,1,1,2))
7135 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7136 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
7137 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
7138 ADtEA1derx(1,1,1,1,1,2))
7140 ! End 6-th order cumulants
7141 call transpose2(EUgder(1,1,j),auxmat(1,1))
7142 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7143 call transpose2(EUg(1,1,j),auxmat(1,1))
7144 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7145 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7149 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7150 EAEAderx(1,1,lll,kkk,iii,2))
7155 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7156 ! They are needed only when the fifth- or the sixth-order cumulants are
7158 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
7159 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7160 call transpose2(AEA(1,1,1),auxmat(1,1))
7161 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7162 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7163 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7164 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7165 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7166 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7167 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7168 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7169 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7170 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7171 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7172 call transpose2(AEA(1,1,2),auxmat(1,1))
7173 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7174 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7175 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7176 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7177 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7178 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7179 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7180 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7181 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7182 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7183 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7184 ! Calculate the Cartesian derivatives of the vectors.
7188 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7189 call matvec2(auxmat(1,1),b1(1,iti),&
7190 AEAb1derx(1,lll,kkk,iii,1,1))
7191 call matvec2(auxmat(1,1),Ub2(1,i),&
7192 AEAb2derx(1,lll,kkk,iii,1,1))
7193 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
7194 AEAb1derx(1,lll,kkk,iii,2,1))
7195 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
7196 AEAb2derx(1,lll,kkk,iii,2,1))
7197 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7198 call matvec2(auxmat(1,1),b1(1,itl),&
7199 AEAb1derx(1,lll,kkk,iii,1,2))
7200 call matvec2(auxmat(1,1),Ub2(1,l),&
7201 AEAb2derx(1,lll,kkk,iii,1,2))
7202 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
7203 AEAb1derx(1,lll,kkk,iii,2,2))
7204 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
7205 AEAb2derx(1,lll,kkk,iii,2,2))
7213 end subroutine calc_eello
7214 !-----------------------------------------------------------------------------
7215 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
7220 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
7221 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
7222 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
7223 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
7224 integer :: iii,kkk,lll
7227 !el common /kutas/ lprn
7228 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7230 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
7233 !d if (lprn) write (2,*) 'In kernel'
7235 !d if (lprn) write (2,*) 'kkk=',kkk
7237 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
7238 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7240 !d write (2,*) 'lll=',lll
7241 !d write (2,*) 'iii=1'
7243 !d write (2,'(3(2f10.5),5x)')
7244 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7247 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
7248 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7250 !d write (2,*) 'lll=',lll
7251 !d write (2,*) 'iii=2'
7253 !d write (2,'(3(2f10.5),5x)')
7254 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7260 end subroutine kernel
7261 !-----------------------------------------------------------------------------
7262 real(kind=8) function eello4(i,j,k,l,jj,kk)
7263 ! implicit real*8 (a-h,o-z)
7264 ! include 'DIMENSIONS'
7265 ! include 'COMMON.IOUNITS'
7266 ! include 'COMMON.CHAIN'
7267 ! include 'COMMON.DERIV'
7268 ! include 'COMMON.INTERACT'
7269 ! include 'COMMON.CONTACTS'
7270 ! include 'COMMON.TORSION'
7271 ! include 'COMMON.VAR'
7272 ! include 'COMMON.GEO'
7273 real(kind=8),dimension(2,2) :: pizda
7274 real(kind=8),dimension(3) :: ggg1,ggg2
7275 real(kind=8) :: eel4,glongij,glongkl
7276 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
7277 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7281 !d print *,'eello4:',i,j,k,l,jj,kk
7282 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
7283 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
7284 !old eij=facont_hb(jj,i)
7285 !old ekl=facont_hb(kk,k)
7287 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7288 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7289 gcorr_loc(k-1)=gcorr_loc(k-1) &
7290 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7292 gcorr_loc(l-1)=gcorr_loc(l-1) &
7293 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7295 gcorr_loc(j-1)=gcorr_loc(j-1) &
7296 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7301 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
7302 -EAEAderx(2,2,lll,kkk,iii,1)
7303 !d derx(lll,kkk,iii)=0.0d0
7307 !d gcorr_loc(l-1)=0.0d0
7308 !d gcorr_loc(j-1)=0.0d0
7309 !d gcorr_loc(k-1)=0.0d0
7311 !d write (iout,*)'Contacts have occurred for peptide groups',
7312 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
7313 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7314 if (j.lt.nres-1) then
7321 if (l.lt.nres-1) then
7329 !grad ggg1(ll)=eel4*g_contij(ll,1)
7330 !grad ggg2(ll)=eel4*g_contij(ll,2)
7331 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7332 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7333 !grad ghalf=0.5d0*ggg1(ll)
7334 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7335 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7336 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7337 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7338 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7339 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7340 !grad ghalf=0.5d0*ggg2(ll)
7341 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7342 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7343 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7344 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7345 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7346 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7350 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7355 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7360 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7365 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7369 !d write (2,*) iii,gcorr_loc(iii)
7372 !d write (2,*) 'ekont',ekont
7373 !d write (iout,*) 'eello4',ekont*eel4
7376 !-----------------------------------------------------------------------------
7377 real(kind=8) function eello5(i,j,k,l,jj,kk)
7378 ! implicit real*8 (a-h,o-z)
7379 ! include 'DIMENSIONS'
7380 ! include 'COMMON.IOUNITS'
7381 ! include 'COMMON.CHAIN'
7382 ! include 'COMMON.DERIV'
7383 ! include 'COMMON.INTERACT'
7384 ! include 'COMMON.CONTACTS'
7385 ! include 'COMMON.TORSION'
7386 ! include 'COMMON.VAR'
7387 ! include 'COMMON.GEO'
7388 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
7389 real(kind=8),dimension(2) :: vv
7390 real(kind=8),dimension(3) :: ggg1,ggg2
7391 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
7392 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
7393 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
7394 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7399 ! /l\ / \ \ / \ / \ / C
7400 ! / \ / \ \ / \ / \ / C
7401 ! j| o |l1 | o | o| o | | o |o C
7402 ! \ |/k\| |/ \| / |/ \| |/ \| C
7403 ! \i/ \ / \ / / \ / \ C
7405 ! (I) (II) (III) (IV) C
7407 ! eello5_1 eello5_2 eello5_3 eello5_4 C
7409 ! Antiparallel chains C
7412 ! /j\ / \ \ / \ / \ / C
7413 ! / \ / \ \ / \ / \ / C
7414 ! j1| o |l | o | o| o | | o |o C
7415 ! \ |/k\| |/ \| / |/ \| |/ \| C
7416 ! \i/ \ / \ / / \ / \ C
7418 ! (I) (II) (III) (IV) C
7420 ! eello5_1 eello5_2 eello5_3 eello5_4 C
7422 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
7424 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7425 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7430 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7432 itk=itortyp(itype(k))
7433 itl=itortyp(itype(l))
7434 itj=itortyp(itype(j))
7439 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7440 !d & eel5_3_num,eel5_4_num)
7444 derx(lll,kkk,iii)=0.0d0
7448 !d eij=facont_hb(jj,i)
7449 !d ekl=facont_hb(kk,k)
7451 !d write (iout,*)'Contacts have occurred for peptide groups',
7452 !d & i,j,' fcont:',eij,' eij',' and ',k,l
7454 ! Contribution from the graph I.
7455 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7456 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7457 call transpose2(EUg(1,1,k),auxmat(1,1))
7458 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7459 vv(1)=pizda(1,1)-pizda(2,2)
7460 vv(2)=pizda(1,2)+pizda(2,1)
7461 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
7462 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7463 ! Explicit gradient in virtual-dihedral angles.
7464 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
7465 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
7466 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7467 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7468 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7469 vv(1)=pizda(1,1)-pizda(2,2)
7470 vv(2)=pizda(1,2)+pizda(2,1)
7471 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7472 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
7473 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7474 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7475 vv(1)=pizda(1,1)-pizda(2,2)
7476 vv(2)=pizda(1,2)+pizda(2,1)
7478 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7479 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
7480 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7482 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7483 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
7484 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7486 ! Cartesian gradient
7490 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
7492 vv(1)=pizda(1,1)-pizda(2,2)
7493 vv(2)=pizda(1,2)+pizda(2,1)
7494 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7495 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
7496 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7502 ! Contribution from graph II
7503 call transpose2(EE(1,1,itk),auxmat(1,1))
7504 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7505 vv(1)=pizda(1,1)+pizda(2,2)
7506 vv(2)=pizda(2,1)-pizda(1,2)
7507 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
7508 -0.5d0*scalar2(vv(1),Ctobr(1,k))
7509 ! Explicit gradient in virtual-dihedral angles.
7510 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7511 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7512 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7513 vv(1)=pizda(1,1)+pizda(2,2)
7514 vv(2)=pizda(2,1)-pizda(1,2)
7516 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7517 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
7518 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7520 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7521 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
7522 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7524 ! Cartesian gradient
7528 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7530 vv(1)=pizda(1,1)+pizda(2,2)
7531 vv(2)=pizda(2,1)-pizda(1,2)
7532 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7533 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
7534 -0.5d0*scalar2(vv(1),Ctobr(1,k))
7542 ! Parallel orientation
7543 ! Contribution from graph III
7544 call transpose2(EUg(1,1,l),auxmat(1,1))
7545 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7546 vv(1)=pizda(1,1)-pizda(2,2)
7547 vv(2)=pizda(1,2)+pizda(2,1)
7548 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
7549 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7550 ! Explicit gradient in virtual-dihedral angles.
7551 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7552 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
7553 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7554 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7555 vv(1)=pizda(1,1)-pizda(2,2)
7556 vv(2)=pizda(1,2)+pizda(2,1)
7557 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7558 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
7559 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7560 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7561 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7562 vv(1)=pizda(1,1)-pizda(2,2)
7563 vv(2)=pizda(1,2)+pizda(2,1)
7564 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7565 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
7566 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7567 ! Cartesian gradient
7571 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
7573 vv(1)=pizda(1,1)-pizda(2,2)
7574 vv(2)=pizda(1,2)+pizda(2,1)
7575 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7576 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
7577 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7582 ! Contribution from graph IV
7584 call transpose2(EE(1,1,itl),auxmat(1,1))
7585 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7586 vv(1)=pizda(1,1)+pizda(2,2)
7587 vv(2)=pizda(2,1)-pizda(1,2)
7588 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
7589 -0.5d0*scalar2(vv(1),Ctobr(1,l))
7590 ! Explicit gradient in virtual-dihedral angles.
7591 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7592 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7593 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7594 vv(1)=pizda(1,1)+pizda(2,2)
7595 vv(2)=pizda(2,1)-pizda(1,2)
7596 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7597 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
7598 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7599 ! Cartesian gradient
7603 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7605 vv(1)=pizda(1,1)+pizda(2,2)
7606 vv(2)=pizda(2,1)-pizda(1,2)
7607 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7608 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
7609 -0.5d0*scalar2(vv(1),Ctobr(1,l))
7614 ! Antiparallel orientation
7615 ! Contribution from graph III
7617 call transpose2(EUg(1,1,j),auxmat(1,1))
7618 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7619 vv(1)=pizda(1,1)-pizda(2,2)
7620 vv(2)=pizda(1,2)+pizda(2,1)
7621 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
7622 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7623 ! Explicit gradient in virtual-dihedral angles.
7624 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7625 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
7626 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7627 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7628 vv(1)=pizda(1,1)-pizda(2,2)
7629 vv(2)=pizda(1,2)+pizda(2,1)
7630 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7631 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
7632 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7633 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7634 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7635 vv(1)=pizda(1,1)-pizda(2,2)
7636 vv(2)=pizda(1,2)+pizda(2,1)
7637 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7638 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
7639 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7640 ! Cartesian gradient
7644 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
7646 vv(1)=pizda(1,1)-pizda(2,2)
7647 vv(2)=pizda(1,2)+pizda(2,1)
7648 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
7649 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
7650 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7655 ! Contribution from graph IV
7657 call transpose2(EE(1,1,itj),auxmat(1,1))
7658 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7659 vv(1)=pizda(1,1)+pizda(2,2)
7660 vv(2)=pizda(2,1)-pizda(1,2)
7661 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
7662 -0.5d0*scalar2(vv(1),Ctobr(1,j))
7663 ! Explicit gradient in virtual-dihedral angles.
7664 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7665 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7666 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7667 vv(1)=pizda(1,1)+pizda(2,2)
7668 vv(2)=pizda(2,1)-pizda(1,2)
7669 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7670 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
7671 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7672 ! Cartesian gradient
7676 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7678 vv(1)=pizda(1,1)+pizda(2,2)
7679 vv(2)=pizda(2,1)-pizda(1,2)
7680 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
7681 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
7682 -0.5d0*scalar2(vv(1),Ctobr(1,j))
7688 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7689 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7690 !d write (2,*) 'ijkl',i,j,k,l
7691 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7692 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
7694 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7695 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7696 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7697 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7698 if (j.lt.nres-1) then
7705 if (l.lt.nres-1) then
7715 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7716 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
7717 ! summed up outside the subrouine as for the other subroutines
7718 ! handling long-range interactions. The old code is commented out
7719 ! with "cgrad" to keep track of changes.
7721 !grad ggg1(ll)=eel5*g_contij(ll,1)
7722 !grad ggg2(ll)=eel5*g_contij(ll,2)
7723 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7724 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7725 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7726 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7727 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7728 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7729 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7730 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7732 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7733 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7734 !grad ghalf=0.5d0*ggg1(ll)
7736 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7737 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7738 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7739 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7740 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7741 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7742 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7743 !grad ghalf=0.5d0*ggg2(ll)
7745 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7746 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7747 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7748 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7749 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7750 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7755 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7756 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7761 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7762 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7768 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7773 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7777 !d write (2,*) iii,g_corr5_loc(iii)
7780 !d write (2,*) 'ekont',ekont
7781 !d write (iout,*) 'eello5',ekont*eel5
7784 !-----------------------------------------------------------------------------
7785 real(kind=8) function eello6(i,j,k,l,jj,kk)
7786 ! implicit real*8 (a-h,o-z)
7787 ! include 'DIMENSIONS'
7788 ! include 'COMMON.IOUNITS'
7789 ! include 'COMMON.CHAIN'
7790 ! include 'COMMON.DERIV'
7791 ! include 'COMMON.INTERACT'
7792 ! include 'COMMON.CONTACTS'
7793 ! include 'COMMON.TORSION'
7794 ! include 'COMMON.VAR'
7795 ! include 'COMMON.GEO'
7796 ! include 'COMMON.FFIELD'
7797 real(kind=8),dimension(3) :: ggg1,ggg2
7798 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
7800 real(kind=8) :: gradcorr6ij,gradcorr6kl
7801 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
7802 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7807 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7815 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7816 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7820 derx(lll,kkk,iii)=0.0d0
7824 !d eij=facont_hb(jj,i)
7825 !d ekl=facont_hb(kk,k)
7831 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7832 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7833 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7834 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7835 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7836 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7838 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7839 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7840 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7841 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7842 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7843 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7847 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7849 ! If turn contributions are considered, they will be handled separately.
7850 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7851 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7852 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7853 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7854 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7855 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7856 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7858 if (j.lt.nres-1) then
7865 if (l.lt.nres-1) then
7873 !grad ggg1(ll)=eel6*g_contij(ll,1)
7874 !grad ggg2(ll)=eel6*g_contij(ll,2)
7875 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7876 !grad ghalf=0.5d0*ggg1(ll)
7878 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7879 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7880 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7881 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7882 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7883 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7884 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7885 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7886 !grad ghalf=0.5d0*ggg2(ll)
7887 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7889 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7890 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7891 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7892 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7893 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7894 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7899 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7900 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7905 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7906 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7912 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7917 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7921 !d write (2,*) iii,g_corr6_loc(iii)
7924 !d write (2,*) 'ekont',ekont
7925 !d write (iout,*) 'eello6',ekont*eel6
7928 !-----------------------------------------------------------------------------
7929 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
7931 ! implicit real*8 (a-h,o-z)
7932 ! include 'DIMENSIONS'
7933 ! include 'COMMON.IOUNITS'
7934 ! include 'COMMON.CHAIN'
7935 ! include 'COMMON.DERIV'
7936 ! include 'COMMON.INTERACT'
7937 ! include 'COMMON.CONTACTS'
7938 ! include 'COMMON.TORSION'
7939 ! include 'COMMON.VAR'
7940 ! include 'COMMON.GEO'
7941 real(kind=8),dimension(2) :: vv,vv1
7942 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
7945 !el common /kutas/ lprn
7946 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
7947 real(kind=8) :: s1,s2,s3,s4,s5
7948 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7950 ! Parallel Antiparallel C
7956 ! \ j|/k\| / \ |/k\|l / C
7961 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7962 itk=itortyp(itype(k))
7963 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7964 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7965 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7966 call transpose2(EUgC(1,1,k),auxmat(1,1))
7967 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7968 vv1(1)=pizda1(1,1)-pizda1(2,2)
7969 vv1(2)=pizda1(1,2)+pizda1(2,1)
7970 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7971 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7972 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7973 s5=scalar2(vv(1),Dtobr2(1,i))
7974 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7975 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7976 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
7977 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
7978 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
7979 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
7980 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
7981 +scalar2(vv(1),Dtobr2der(1,i)))
7982 call matmat2(AEAderg(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 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7986 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7988 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
7989 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
7990 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
7991 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
7992 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7994 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
7995 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
7996 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
7997 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
7998 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8000 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8001 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8002 vv1(1)=pizda1(1,1)-pizda1(2,2)
8003 vv1(2)=pizda1(1,2)+pizda1(2,1)
8004 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
8005 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
8006 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
8007 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8016 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8017 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8018 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8019 call transpose2(EUgC(1,1,k),auxmat(1,1))
8020 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
8022 vv1(1)=pizda1(1,1)-pizda1(2,2)
8023 vv1(2)=pizda1(1,2)+pizda1(2,1)
8024 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8025 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
8026 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8027 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
8028 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8029 s5=scalar2(vv(1),Dtobr2(1,i))
8030 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8035 end function eello6_graph1
8036 !-----------------------------------------------------------------------------
8037 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
8039 ! implicit real*8 (a-h,o-z)
8040 ! include 'DIMENSIONS'
8041 ! include 'COMMON.IOUNITS'
8042 ! include 'COMMON.CHAIN'
8043 ! include 'COMMON.DERIV'
8044 ! include 'COMMON.INTERACT'
8045 ! include 'COMMON.CONTACTS'
8046 ! include 'COMMON.TORSION'
8047 ! include 'COMMON.VAR'
8048 ! include 'COMMON.GEO'
8050 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
8051 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8053 !el common /kutas/ lprn
8054 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
8055 real(kind=8) :: s2,s3,s4
8056 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8058 ! Parallel Antiparallel C
8064 ! \ j|/k\| \ |/k\|l C
8069 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8070 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8071 ! AL 7/4/01 s1 would occur in the sixth-order moment,
8072 ! but not in a cluster cumulant
8074 s1=dip(1,jj,i)*dip(1,kk,k)
8076 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8077 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8078 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8079 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8080 call transpose2(EUg(1,1,k),auxmat(1,1))
8081 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8082 vv(1)=pizda(1,1)-pizda(2,2)
8083 vv(2)=pizda(1,2)+pizda(2,1)
8084 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8085 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8087 eello6_graph2=-(s1+s2+s3+s4)
8089 eello6_graph2=-(s2+s3+s4)
8092 ! Derivatives in gamma(i-1)
8095 s1=dipderg(1,jj,i)*dip(1,kk,k)
8097 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8098 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8099 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8100 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8102 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8104 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8106 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8108 ! Derivatives in gamma(k-1)
8110 s1=dip(1,jj,i)*dipderg(1,kk,k)
8112 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8113 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8114 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8115 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8116 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8117 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8118 vv(1)=pizda(1,1)-pizda(2,2)
8119 vv(2)=pizda(1,2)+pizda(2,1)
8120 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8122 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8124 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8126 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8127 ! Derivatives in gamma(j-1) or gamma(l-1)
8130 s1=dipderg(3,jj,i)*dip(1,kk,k)
8132 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8133 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8134 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8135 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8136 vv(1)=pizda(1,1)-pizda(2,2)
8137 vv(2)=pizda(1,2)+pizda(2,1)
8138 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8141 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8143 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8146 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8147 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8149 ! Derivatives in gamma(l-1) or gamma(j-1)
8152 s1=dip(1,jj,i)*dipderg(3,kk,k)
8154 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8155 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8156 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8157 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8158 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8159 vv(1)=pizda(1,1)-pizda(2,2)
8160 vv(2)=pizda(1,2)+pizda(2,1)
8161 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8164 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8166 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8169 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8170 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8172 ! Cartesian derivatives.
8174 write (2,*) 'In eello6_graph2'
8176 write (2,*) 'iii=',iii
8178 write (2,*) 'kkk=',kkk
8180 write (2,'(3(2f10.5),5x)') &
8181 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8191 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8193 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8196 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
8198 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8199 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
8201 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8202 call transpose2(EUg(1,1,k),auxmat(1,1))
8203 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8205 vv(1)=pizda(1,1)-pizda(2,2)
8206 vv(2)=pizda(1,2)+pizda(2,1)
8207 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8208 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8210 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8212 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8215 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8217 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8223 end function eello6_graph2
8224 !-----------------------------------------------------------------------------
8225 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
8226 ! implicit real*8 (a-h,o-z)
8227 ! include 'DIMENSIONS'
8228 ! include 'COMMON.IOUNITS'
8229 ! include 'COMMON.CHAIN'
8230 ! include 'COMMON.DERIV'
8231 ! include 'COMMON.INTERACT'
8232 ! include 'COMMON.CONTACTS'
8233 ! include 'COMMON.TORSION'
8234 ! include 'COMMON.VAR'
8235 ! include 'COMMON.GEO'
8236 real(kind=8),dimension(2) :: vv,auxvec
8237 real(kind=8),dimension(2,2) :: pizda,auxmat
8239 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
8240 real(kind=8) :: s1,s2,s3,s4
8241 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8243 ! Parallel Antiparallel C
8249 ! j|/k\| / |/k\|l / C
8254 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8256 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
8257 ! energy moment and not to the cluster cumulant.
8258 iti=itortyp(itype(i))
8259 if (j.lt.nres-1) then
8260 itj1=itortyp(itype(j+1))
8264 itk=itortyp(itype(k))
8265 itk1=itortyp(itype(k+1))
8266 if (l.lt.nres-1) then
8267 itl1=itortyp(itype(l+1))
8272 s1=dip(4,jj,i)*dip(4,kk,k)
8274 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8275 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8276 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8277 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8278 call transpose2(EE(1,1,itk),auxmat(1,1))
8279 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8280 vv(1)=pizda(1,1)+pizda(2,2)
8281 vv(2)=pizda(2,1)-pizda(1,2)
8282 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8283 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8284 !d & "sum",-(s2+s3+s4)
8286 eello6_graph3=-(s1+s2+s3+s4)
8288 eello6_graph3=-(s2+s3+s4)
8291 ! Derivatives in gamma(k-1)
8292 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8293 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8294 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8295 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8296 ! Derivatives in gamma(l-1)
8297 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8298 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8299 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8300 vv(1)=pizda(1,1)+pizda(2,2)
8301 vv(2)=pizda(2,1)-pizda(1,2)
8302 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8303 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8304 ! Cartesian derivatives.
8310 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8312 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8315 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8317 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8318 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8320 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8321 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
8323 vv(1)=pizda(1,1)+pizda(2,2)
8324 vv(2)=pizda(2,1)-pizda(1,2)
8325 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8327 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8329 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8332 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8334 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8336 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8341 end function eello6_graph3
8342 !-----------------------------------------------------------------------------
8343 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8344 ! implicit real*8 (a-h,o-z)
8345 ! include 'DIMENSIONS'
8346 ! include 'COMMON.IOUNITS'
8347 ! include 'COMMON.CHAIN'
8348 ! include 'COMMON.DERIV'
8349 ! include 'COMMON.INTERACT'
8350 ! include 'COMMON.CONTACTS'
8351 ! include 'COMMON.TORSION'
8352 ! include 'COMMON.VAR'
8353 ! include 'COMMON.GEO'
8354 ! include 'COMMON.FFIELD'
8355 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
8356 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8358 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
8360 real(kind=8) :: s1,s2,s3,s4
8361 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8363 ! Parallel Antiparallel C
8369 ! \ j|/k\| \ |/k\|l C
8374 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8376 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
8377 ! energy moment and not to the cluster cumulant.
8378 !d write (2,*) 'eello_graph4: wturn6',wturn6
8379 iti=itortyp(itype(i))
8380 itj=itortyp(itype(j))
8381 if (j.lt.nres-1) then
8382 itj1=itortyp(itype(j+1))
8386 itk=itortyp(itype(k))
8387 if (k.lt.nres-1) then
8388 itk1=itortyp(itype(k+1))
8392 itl=itortyp(itype(l))
8393 if (l.lt.nres-1) then
8394 itl1=itortyp(itype(l+1))
8398 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8399 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8400 !d & ' itl',itl,' itl1',itl1
8403 s1=dip(3,jj,i)*dip(3,kk,k)
8405 s1=dip(2,jj,j)*dip(2,kk,l)
8408 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8409 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8411 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8412 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8414 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8415 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8417 call transpose2(EUg(1,1,k),auxmat(1,1))
8418 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8419 vv(1)=pizda(1,1)-pizda(2,2)
8420 vv(2)=pizda(2,1)+pizda(1,2)
8421 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8422 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8424 eello6_graph4=-(s1+s2+s3+s4)
8426 eello6_graph4=-(s2+s3+s4)
8428 ! Derivatives in gamma(i-1)
8432 s1=dipderg(2,jj,i)*dip(3,kk,k)
8434 s1=dipderg(4,jj,j)*dip(2,kk,l)
8437 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8439 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8440 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8442 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8443 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8445 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8446 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8447 !d write (2,*) 'turn6 derivatives'
8449 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8451 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8455 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8457 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8461 ! Derivatives in gamma(k-1)
8464 s1=dip(3,jj,i)*dipderg(2,kk,k)
8466 s1=dip(2,jj,j)*dipderg(4,kk,l)
8469 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8470 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8472 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8473 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8475 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8476 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8478 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8479 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8480 vv(1)=pizda(1,1)-pizda(2,2)
8481 vv(2)=pizda(2,1)+pizda(1,2)
8482 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8483 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8485 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8487 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8491 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8493 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8496 ! Derivatives in gamma(j-1) or gamma(l-1)
8497 if (l.eq.j+1 .and. l.gt.1) then
8498 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8499 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8500 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8501 vv(1)=pizda(1,1)-pizda(2,2)
8502 vv(2)=pizda(2,1)+pizda(1,2)
8503 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8504 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8505 else if (j.gt.1) then
8506 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8507 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8508 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8509 vv(1)=pizda(1,1)-pizda(2,2)
8510 vv(2)=pizda(2,1)+pizda(1,2)
8511 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8512 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8513 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8515 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8518 ! Cartesian derivatives.
8525 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8527 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8531 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8533 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8537 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
8539 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8541 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
8542 b1(1,itj1),auxvec(1))
8543 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8545 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
8546 b1(1,itl1),auxvec(1))
8547 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8549 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
8551 vv(1)=pizda(1,1)-pizda(2,2)
8552 vv(2)=pizda(2,1)+pizda(1,2)
8553 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8555 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8557 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
8560 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
8563 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8566 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8568 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8570 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8574 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8576 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8579 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8581 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8588 end function eello6_graph4
8589 !-----------------------------------------------------------------------------
8590 real(kind=8) function eello_turn6(i,jj,kk)
8591 ! implicit real*8 (a-h,o-z)
8592 ! include 'DIMENSIONS'
8593 ! include 'COMMON.IOUNITS'
8594 ! include 'COMMON.CHAIN'
8595 ! include 'COMMON.DERIV'
8596 ! include 'COMMON.INTERACT'
8597 ! include 'COMMON.CONTACTS'
8598 ! include 'COMMON.TORSION'
8599 ! include 'COMMON.VAR'
8600 ! include 'COMMON.GEO'
8601 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
8602 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
8603 real(kind=8),dimension(3) :: ggg1,ggg2
8604 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
8605 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
8606 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8607 ! the respective energy moment and not to the cluster cumulant.
8609 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
8610 integer :: j1,j2,l1,l2,ll
8611 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
8612 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
8621 iti=itortyp(itype(i))
8622 itk=itortyp(itype(k))
8623 itk1=itortyp(itype(k+1))
8624 itl=itortyp(itype(l))
8625 itj=itortyp(itype(j))
8626 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8627 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
8628 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8633 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8635 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
8639 derx_turn(lll,kkk,iii)=0.0d0
8646 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8648 !d write (2,*) 'eello6_5',eello6_5
8650 call transpose2(AEA(1,1,1),auxmat(1,1))
8651 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8652 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8653 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8655 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8656 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8657 s2 = scalar2(b1(1,itk),vtemp1(1))
8659 call transpose2(AEA(1,1,2),atemp(1,1))
8660 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8661 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8662 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8664 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8665 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8666 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8668 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8669 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8670 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8671 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8672 ss13 = scalar2(b1(1,itk),vtemp4(1))
8673 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8675 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8681 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8682 ! Derivatives in gamma(i+2)
8686 call transpose2(AEA(1,1,1),auxmatd(1,1))
8687 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8688 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8689 call transpose2(AEAderg(1,1,2),atempd(1,1))
8690 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8691 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8693 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8694 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8695 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8701 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8702 ! Derivatives in gamma(i+3)
8704 call transpose2(AEA(1,1,1),auxmatd(1,1))
8705 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8706 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8707 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8709 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8710 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8711 s2d = scalar2(b1(1,itk),vtemp1d(1))
8713 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8714 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8716 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8718 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8719 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8720 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8728 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
8729 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8731 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
8732 -0.5d0*ekont*(s2d+s12d)
8734 ! Derivatives in gamma(i+4)
8735 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8736 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8737 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8739 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8740 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8741 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8749 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8751 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8753 ! Derivatives in gamma(i+5)
8755 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8756 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8757 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8759 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8760 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8761 s2d = scalar2(b1(1,itk),vtemp1d(1))
8763 call transpose2(AEA(1,1,2),atempd(1,1))
8764 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8765 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8767 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8768 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8770 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8771 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8772 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8780 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
8781 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8783 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
8784 -0.5d0*ekont*(s2d+s12d)
8786 ! Cartesian derivatives
8791 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8792 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8793 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8795 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8796 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
8798 s2d = scalar2(b1(1,itk),vtemp1d(1))
8800 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8801 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8802 s8d = -(atempd(1,1)+atempd(2,2))* &
8803 scalar2(cc(1,1,itl),vtemp2(1))
8805 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
8807 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8808 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8815 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
8818 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
8822 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
8825 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
8834 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
8836 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8837 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8838 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8839 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8840 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
8842 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8843 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8844 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8848 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8849 !d & 16*eel_turn6_num
8851 if (j.lt.nres-1) then
8858 if (l.lt.nres-1) then
8866 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
8867 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
8868 !grad ghalf=0.5d0*ggg1(ll)
8870 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8871 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8872 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
8873 +ekont*derx_turn(ll,2,1)
8874 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8875 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
8876 +ekont*derx_turn(ll,4,1)
8877 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8878 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8879 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8880 !grad ghalf=0.5d0*ggg2(ll)
8882 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
8883 +ekont*derx_turn(ll,2,2)
8884 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8885 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
8886 +ekont*derx_turn(ll,4,2)
8887 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8888 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8889 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8894 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8899 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8905 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8910 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8914 !d write (2,*) iii,g_corr6_loc(iii)
8916 eello_turn6=ekont*eel_turn6
8917 !d write (2,*) 'ekont',ekont
8918 !d write (2,*) 'eel_turn6',ekont*eel_turn6
8920 end function eello_turn6
8921 !-----------------------------------------------------------------------------
8922 subroutine MATVEC2(A1,V1,V2)
8923 !DIR$ INLINEALWAYS MATVEC2
8925 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8927 ! implicit real*8 (a-h,o-z)
8928 ! include 'DIMENSIONS'
8929 real(kind=8),dimension(2) :: V1,V2
8930 real(kind=8),dimension(2,2) :: A1
8931 real(kind=8) :: vaux1,vaux2
8935 ! 3 VI=VI+A1(I,K)*V1(K)
8939 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8940 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8944 end subroutine MATVEC2
8945 !-----------------------------------------------------------------------------
8946 subroutine MATMAT2(A1,A2,A3)
8948 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8950 ! implicit real*8 (a-h,o-z)
8951 ! include 'DIMENSIONS'
8952 real(kind=8),dimension(2,2) :: A1,A2,A3
8953 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
8954 ! DIMENSION AI3(2,2)
8958 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
8964 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8965 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8966 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8967 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8973 end subroutine MATMAT2
8974 !-----------------------------------------------------------------------------
8975 real(kind=8) function scalar2(u,v)
8976 !DIR$ INLINEALWAYS scalar2
8978 real(kind=8),dimension(2) :: u,v
8981 scalar2=u(1)*v(1)+u(2)*v(2)
8983 end function scalar2
8984 !-----------------------------------------------------------------------------
8985 subroutine transpose2(a,at)
8986 !DIR$ INLINEALWAYS transpose2
8988 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
8991 real(kind=8),dimension(2,2) :: a,at
8997 end subroutine transpose2
8998 !-----------------------------------------------------------------------------
8999 subroutine transpose(n,a,at)
9002 real(kind=8),dimension(n,n) :: a,at
9009 end subroutine transpose
9010 !-----------------------------------------------------------------------------
9011 subroutine prodmat3(a1,a2,kk,transp,prod)
9012 !DIR$ INLINEALWAYS prodmat3
9014 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
9018 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
9020 !rc double precision auxmat(2,2),prod_(2,2)
9023 !rc call transpose2(kk(1,1),auxmat(1,1))
9024 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9025 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9027 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
9028 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9029 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
9030 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9031 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
9032 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9033 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
9034 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9037 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9038 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9040 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
9041 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9042 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
9043 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9044 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
9045 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9046 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
9047 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9050 ! call transpose2(a2(1,1),a2t(1,1))
9053 !rc print *,((prod_(i,j),i=1,2),j=1,2)
9054 !rc print *,((prod(i,j),i=1,2),j=1,2)
9057 end subroutine prodmat3
9058 !-----------------------------------------------------------------------------
9059 ! energy_p_new_barrier.F
9060 !-----------------------------------------------------------------------------
9061 subroutine sum_gradient
9062 ! implicit real*8 (a-h,o-z)
9063 use io_base, only: pdbout
9064 ! include 'DIMENSIONS'
9068 !MS$ATTRIBUTES C :: proc_proc
9074 real(kind=8),dimension(3,nres) :: gradbufc,gradbufx,gradbufc_sum,&
9075 gloc_scbuf !(3,maxres)
9077 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
9080 integer :: i,j,k,ierror,ierr
9081 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
9082 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
9083 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
9084 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
9085 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
9086 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
9087 gsccorr_max,gsccorrx_max,time00
9089 ! include 'COMMON.SETUP'
9090 ! include 'COMMON.IOUNITS'
9091 ! include 'COMMON.FFIELD'
9092 ! include 'COMMON.DERIV'
9093 ! include 'COMMON.INTERACT'
9094 ! include 'COMMON.SBRIDGE'
9095 ! include 'COMMON.CHAIN'
9096 ! include 'COMMON.VAR'
9097 ! include 'COMMON.CONTROL'
9098 ! include 'COMMON.TIME1'
9099 ! include 'COMMON.MAXGRAD'
9100 ! include 'COMMON.SCCOR'
9105 write (iout,*) "sum_gradient gvdwc, gvdwx"
9107 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9108 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
9118 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
9119 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
9120 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
9123 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
9124 ! in virtual-bond-vector coordinates
9127 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
9129 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
9130 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
9132 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
9134 ! write (iout,'(i5,3f10.5,2x,f10.5)')
9135 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
9137 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
9139 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9140 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
9141 (gvdwc_scpp(j,i),j=1,3)
9143 write (iout,*) "gelc_long gvdwpp gel_loc_long"
9145 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9146 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
9147 (gelc_loc_long(j,i),j=1,3)
9154 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
9155 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
9156 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
9157 wel_loc*gel_loc_long(j,i)+ &
9158 wcorr*gradcorr_long(j,i)+ &
9159 wcorr5*gradcorr5_long(j,i)+ &
9160 wcorr6*gradcorr6_long(j,i)+ &
9161 wturn6*gcorr6_turn_long(j,i)+ &
9168 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
9169 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
9170 welec*gelc_long(j,i)+ &
9172 wel_loc*gel_loc_long(j,i)+ &
9173 wcorr*gradcorr_long(j,i)+ &
9174 wcorr5*gradcorr5_long(j,i)+ &
9175 wcorr6*gradcorr6_long(j,i)+ &
9176 wturn6*gcorr6_turn_long(j,i)+ &
9182 if (nfgtasks.gt.1) then
9185 write (iout,*) "gradbufc before allreduce"
9187 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9193 gradbufc_sum(j,i)=gradbufc(j,i)
9196 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
9197 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
9198 ! time_reduce=time_reduce+MPI_Wtime()-time00
9200 ! write (iout,*) "gradbufc_sum after allreduce"
9202 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
9207 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
9215 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
9216 write (iout,*) (i," jgrad_start",jgrad_start(i),&
9217 " jgrad_end ",jgrad_end(i),&
9218 i=igrad_start,igrad_end)
9221 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
9222 ! do not parallelize this part.
9224 ! do i=igrad_start,igrad_end
9225 ! do j=jgrad_start(i),jgrad_end(i)
9227 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
9232 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
9236 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
9240 write (iout,*) "gradbufc after summing"
9242 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9250 write (iout,*) "gradbufc"
9252 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9259 gradbufc_sum(j,i)=gradbufc(j,i)
9264 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
9268 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
9273 ! gradbufc(k,i)=0.0d0
9277 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
9283 write (iout,*) "gradbufc after summing"
9285 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9294 gradbufc(k,nres)=0.0d0
9297 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
9298 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
9299 !el-----------------
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)+wvdwpp*gvdwpp(j,i)+ &
9307 wel_loc*gel_loc_long(j,i)+ &
9308 wcorr*gradcorr_long(j,i)+ &
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 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
9323 wel_loc*gel_loc(j,i)+ &
9324 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
9325 welec*gelc_long(j,i)+ &
9326 wel_loc*gel_loc_long(j,i)+ &
9327 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
9328 wcorr5*gradcorr5_long(j,i)+ &
9329 wcorr6*gradcorr6_long(j,i)+ &
9330 wturn6*gcorr6_turn_long(j,i))+ &
9332 wcorr*gradcorr(j,i)+ &
9333 wturn3*gcorr3_turn(j,i)+ &
9334 wturn4*gcorr4_turn(j,i)+ &
9335 wcorr5*gradcorr5(j,i)+ &
9336 wcorr6*gradcorr6(j,i)+ &
9337 wturn6*gcorr6_turn(j,i)+ &
9338 wsccor*gsccorc(j,i) &
9341 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
9342 wbond*gradbx(j,i)+ &
9343 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
9344 wsccor*gsccorx(j,i) &
9345 +wscloc*gsclocx(j,i)
9349 write (iout,*) "gloc before adding corr"
9351 write (iout,*) i,gloc(i,icg)
9355 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
9356 +wcorr5*g_corr5_loc(i) &
9357 +wcorr6*g_corr6_loc(i) &
9358 +wturn4*gel_loc_turn4(i) &
9359 +wturn3*gel_loc_turn3(i) &
9360 +wturn6*gel_loc_turn6(i) &
9361 +wel_loc*gel_loc_loc(i)
9364 write (iout,*) "gloc after adding corr"
9366 write (iout,*) i,gloc(i,icg)
9370 if (nfgtasks.gt.1) then
9373 gradbufc(j,i)=gradc(j,i,icg)
9374 gradbufx(j,i)=gradx(j,i,icg)
9378 glocbuf(i)=gloc(i,icg)
9382 write (iout,*) "gloc_sc before reduce"
9385 write (iout,*) i,j,gloc_sc(j,i,icg)
9392 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
9396 call MPI_Barrier(FG_COMM,IERR)
9397 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
9399 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,&
9400 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9401 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,&
9402 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9403 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
9404 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9405 time_reduce=time_reduce+MPI_Wtime()-time00
9406 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
9407 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9408 time_reduce=time_reduce+MPI_Wtime()-time00
9411 write (iout,*) "gloc_sc after reduce"
9414 write (iout,*) i,j,gloc_sc(j,i,icg)
9420 write (iout,*) "gloc after reduce"
9422 write (iout,*) i,gloc(i,icg)
9427 if (gnorm_check) then
9429 ! Compute the maximum elements of the gradient
9439 gcorr3_turn_max=0.0d0
9440 gcorr4_turn_max=0.0d0
9443 gcorr6_turn_max=0.0d0
9453 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
9454 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
9455 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
9456 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
9457 gvdwc_scp_max=gvdwc_scp_norm
9458 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
9459 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
9460 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
9461 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
9462 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
9463 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
9464 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
9465 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
9466 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
9467 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
9468 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
9469 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
9470 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
9472 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
9473 gcorr3_turn_max=gcorr3_turn_norm
9474 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
9476 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
9477 gcorr4_turn_max=gcorr4_turn_norm
9478 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
9479 if (gradcorr5_norm.gt.gradcorr5_max) &
9480 gradcorr5_max=gradcorr5_norm
9481 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
9482 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
9483 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
9485 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
9486 gcorr6_turn_max=gcorr6_turn_norm
9487 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
9488 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
9489 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
9490 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
9491 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
9492 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
9493 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
9494 if (gradx_scp_norm.gt.gradx_scp_max) &
9495 gradx_scp_max=gradx_scp_norm
9496 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
9497 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
9498 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
9499 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
9500 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
9501 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
9502 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
9503 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
9507 open(istat,file=statname,position="append")
9509 open(istat,file=statname,access="append")
9511 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
9512 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
9513 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
9514 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
9515 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
9516 gsccorx_max,gsclocx_max
9518 if (gvdwc_max.gt.1.0d4) then
9519 write (iout,*) "gvdwc gvdwx gradb gradbx"
9521 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
9522 gradb(j,i),gradbx(j,i),j=1,3)
9524 call pdbout(0.0d0,'cipiszcze',iout)
9531 write (iout,*) "gradc gradx gloc"
9533 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
9534 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
9539 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
9542 end subroutine sum_gradient
9543 !-----------------------------------------------------------------------------
9545 ! implicit real*8 (a-h,o-z)
9547 ! include 'DIMENSIONS'
9548 ! include 'COMMON.CHAIN'
9549 ! include 'COMMON.DERIV'
9550 ! include 'COMMON.CALC'
9551 ! include 'COMMON.IOUNITS'
9552 real(kind=8), dimension(3) :: dcosom1,dcosom2
9554 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
9555 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
9556 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
9557 -2.0D0*alf12*eps3der+sigder*sigsq_om12
9561 ! eom12=evdwij*eps1_om12
9563 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
9565 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
9566 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
9568 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
9569 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
9572 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
9574 ! write (iout,*) "gg",(gg(k),k=1,3)
9576 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
9577 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
9578 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
9579 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
9580 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
9581 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
9582 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
9583 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
9584 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
9585 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
9588 ! Calculate the components of the gradient in DC and X
9592 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
9596 gvdwc(l,i)=gvdwc(l,i)-gg(l)
9597 gvdwc(l,j)=gvdwc(l,j)+gg(l)
9600 end subroutine sc_grad
9602 !-----------------------------------------------------------------------------
9603 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
9606 ! implicit real*8 (a-h,o-z)
9607 ! include 'DIMENSIONS'
9608 ! include 'COMMON.LOCAL'
9609 ! include 'COMMON.IOUNITS'
9610 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
9611 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
9612 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
9613 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
9614 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
9616 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
9617 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
9618 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
9621 delthec=thetai-thet_pred_mean
9622 delthe0=thetai-theta0i
9623 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
9624 t3 = thetai-thet_pred_mean
9628 t14 = t12+t6*sigsqtc
9630 t21 = thetai-theta0i
9636 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
9637 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
9638 *(-t12*t9-ak*sig0inv*t27)
9640 end subroutine mixder
9642 !-----------------------------------------------------------------------------
9644 !-----------------------------------------------------------------------------
9646 !-----------------------------------------------------------------------------
9647 ! This subroutine calculates the derivatives of the consecutive virtual
9648 ! bond vectors and the SC vectors in the virtual-bond angles theta and
9649 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
9650 ! in the angles alpha and omega, describing the location of a side chain
9651 ! in its local coordinate system.
9653 ! The derivatives are stored in the following arrays:
9655 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
9656 ! The structure is as follows:
9658 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
9659 ! 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)
9660 ! . . . . . . . . . . . . . . . . . .
9661 ! 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)
9665 ! 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)
9667 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
9668 ! The structure is same as above.
9670 ! DCDS - the derivatives of the side chain vectors in the local spherical
9671 ! andgles alph and omega:
9673 ! 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)
9674 ! 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)
9678 ! 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)
9680 ! Version of March '95, based on an early version of November '91.
9682 !**********************************************************************
9683 ! implicit real*8 (a-h,o-z)
9684 ! include 'DIMENSIONS'
9685 ! include 'COMMON.VAR'
9686 ! include 'COMMON.CHAIN'
9687 ! include 'COMMON.DERIV'
9688 ! include 'COMMON.GEO'
9689 ! include 'COMMON.LOCAL'
9690 ! include 'COMMON.INTERACT'
9691 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
9692 real(kind=8),dimension(3,3) :: dp,temp
9693 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
9694 real(kind=8),dimension(3) :: xx,xx1
9696 integer :: i,k,l,j,m,ind,ind1,jjj
9697 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
9698 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
9699 sint2,xp,yp,xxp,yyp,zzp,dj
9701 ! common /przechowalnia/ fromto
9702 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
9703 ! get the position of the jth ijth fragment of the chain coordinate system
9704 ! in the fromto array.
9705 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
9707 ! maxdim=(nres-1)*(nres-2)/2
9708 ! allocate(dcdv(6,maxdim),dxds(6,nres))
9709 ! calculate the derivatives of transformation matrix elements in theta
9712 !el call flush(iout) !el
9714 rdt(1,1,i)=-rt(1,2,i)
9715 rdt(1,2,i)= rt(1,1,i)
9717 rdt(2,1,i)=-rt(2,2,i)
9718 rdt(2,2,i)= rt(2,1,i)
9720 rdt(3,1,i)=-rt(3,2,i)
9721 rdt(3,2,i)= rt(3,1,i)
9725 ! derivatives in phi
9731 drt(2,1,i)= rt(3,1,i)
9732 drt(2,2,i)= rt(3,2,i)
9733 drt(2,3,i)= rt(3,3,i)
9734 drt(3,1,i)=-rt(2,1,i)
9735 drt(3,2,i)=-rt(2,2,i)
9736 drt(3,3,i)=-rt(2,3,i)
9739 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
9750 fromto(k,l,ind)=temp(k,l)
9759 dpkl=dpkl+temp(k,m)*rt(m,l,j)
9762 fromto(k,l,ind)=dpkl
9773 ! Calculate derivatives.
9779 ! Derivatives of DC(i+1) in theta(i+2)
9785 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
9788 prordt(j,k,i)=dp(j,k)
9791 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
9794 ! Derivatives of SC(i+1) in theta(i+2)
9796 xx1(1)=-0.5D0*xloc(2,i+1)
9797 xx1(2)= 0.5D0*xloc(1,i+1)
9801 xj=xj+r(j,k,i)*xx1(k)
9808 rj=rj+prod(j,k,i)*xx(k)
9813 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
9814 ! than the other off-diagonal derivatives.
9819 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
9821 dxdv(j,ind1+1)=dxoiij
9823 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
9825 ! Derivatives of DC(i+1) in phi(i+2)
9831 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
9834 prodrt(j,k,i)=dp(j,k)
9836 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
9839 ! Derivatives of SC(i+1) in phi(i+2)
9842 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
9843 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
9847 rj=rj+prod(j,k,i)*xx(k)
9852 ! Derivatives of SC(i+1) in phi(i+3).
9857 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
9859 dxdv(j+3,ind1+1)=dxoiij
9862 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
9863 ! theta(nres) and phi(i+3) thru phi(nres).
9868 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
9873 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
9878 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
9879 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
9880 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
9881 ! Derivatives of virtual-bond vectors in theta
9883 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
9885 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
9886 ! Derivatives of SC vectors in theta
9890 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
9892 dxdv(k,ind1+1)=dxoijk
9895 !--- Calculate the derivatives in phi
9901 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
9907 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
9912 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
9914 dxdv(k+3,ind1+1)=dxoijk
9919 ! Derivatives in alpha and omega:
9922 ! dsci=dsc(itype(i))
9927 if(alphi.ne.alphi) alphi=100.0
9928 if(omegi.ne.omegi) omegi=-100.0
9933 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
9934 cosalphi=dcos(alphi)
9935 sinalphi=dsin(alphi)
9936 cosomegi=dcos(omegi)
9937 sinomegi=dsin(omegi)
9938 temp(1,1)=-dsci*sinalphi
9939 temp(2,1)= dsci*cosalphi*cosomegi
9940 temp(3,1)=-dsci*cosalphi*sinomegi
9942 temp(2,2)=-dsci*sinalphi*sinomegi
9943 temp(3,2)=-dsci*sinalphi*cosomegi
9944 theta2=pi-0.5D0*theta(i+1)
9948 !d print *,((temp(l,k),l=1,3),k=1,2)
9952 xxp= xp*cost2+yp*sint2
9953 yyp=-xp*sint2+yp*cost2
9956 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
9957 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
9961 dj=dj+prod(k,l,i-1)*xx(l)
9969 end subroutine cartder
9970 !-----------------------------------------------------------------------------
9972 !-----------------------------------------------------------------------------
9973 subroutine check_cartgrad
9974 ! Check the gradient of Cartesian coordinates in internal coordinates.
9975 ! implicit real*8 (a-h,o-z)
9976 ! include 'DIMENSIONS'
9977 ! include 'COMMON.IOUNITS'
9978 ! include 'COMMON.VAR'
9979 ! include 'COMMON.CHAIN'
9980 ! include 'COMMON.GEO'
9981 ! include 'COMMON.LOCAL'
9982 ! include 'COMMON.DERIV'
9983 real(kind=8),dimension(6,nres) :: temp
9984 real(kind=8),dimension(3) :: xx,gg
9986 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
9987 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
9989 ! Check the gradient of the virtual-bond and SC vectors in the internal
9995 write (iout,'(a)') '**************** dx/dalpha'
9999 alph(i)=alph(i)+aincr
10001 temp(k,i)=dc(k,nres+i)
10005 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
10006 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
10008 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
10009 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
10015 write (iout,'(a)') '**************** dx/domega'
10019 omeg(i)=omeg(i)+aincr
10021 temp(k,i)=dc(k,nres+i)
10025 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
10026 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
10027 (aincr*dabs(dxds(k+3,i))+aincr))
10029 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
10030 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
10036 write (iout,'(a)') '**************** dx/dtheta'
10040 theta(i)=theta(i)+aincr
10043 temp(k,j)=dc(k,nres+j)
10049 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
10051 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
10052 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
10053 (aincr*dabs(dxdv(k,ii))+aincr))
10055 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10056 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
10063 write (iout,'(a)') '***************** dx/dphi'
10066 phi(i)=phi(i)+aincr
10069 temp(k,j)=dc(k,nres+j)
10077 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
10078 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
10079 (aincr*dabs(dxdv(k+3,ii))+aincr))
10081 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10082 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
10085 phi(i)=phi(i)-aincr
10088 write (iout,'(a)') '****************** ddc/dtheta'
10091 theta(i+2)=thet+aincr
10102 gg(k)=(dc(k,j)-temp(k,j))/aincr
10103 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
10104 (aincr*dabs(dcdv(k,ii))+aincr))
10106 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10107 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
10117 write (iout,'(a)') '******************* ddc/dphi'
10120 phi(i+3)=phii+aincr
10131 gg(k)=(dc(k,j)-temp(k,j))/aincr
10132 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
10133 (aincr*dabs(dcdv(k+3,ii))+aincr))
10135 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10136 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
10147 end subroutine check_cartgrad
10148 !-----------------------------------------------------------------------------
10149 subroutine check_ecart
10150 ! Check the gradient of the energy in Cartesian coordinates.
10151 ! implicit real*8 (a-h,o-z)
10152 ! include 'DIMENSIONS'
10153 ! include 'COMMON.CHAIN'
10154 ! include 'COMMON.DERIV'
10155 ! include 'COMMON.IOUNITS'
10156 ! include 'COMMON.VAR'
10157 ! include 'COMMON.CONTACTS'
10159 !el integer :: icall
10160 !el common /srutu/ icall
10161 real(kind=8),dimension(6) :: ggg
10162 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
10163 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10164 real(kind=8),dimension(6,nres) :: grad_s
10165 real(kind=8),dimension(0:n_ene) :: energia,energia1
10166 integer :: uiparm(1)
10167 real(kind=8) :: urparm(1)
10169 integer :: nf,i,j,k
10170 real(kind=8) :: aincr,etot,etot1
10176 print '(a)','CG processor',me,' calling CHECK_CART.'
10179 call geom_to_var(nvar,x)
10180 call etotal(energia)
10182 !el call enerprint(energia)
10183 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
10186 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10190 grad_s(j,i)=gradc(j,i,icg)
10191 grad_s(j+3,i)=gradx(j,i,icg)
10195 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10200 ddx(j)=dc(j,i+nres)
10203 dc(j,i)=dc(j,i)+aincr
10205 c(j,k)=c(j,k)+aincr
10206 c(j,k+nres)=c(j,k+nres)+aincr
10208 call etotal(energia1)
10210 ggg(j)=(etot1-etot)/aincr
10213 c(j,k)=c(j,k)-aincr
10214 c(j,k+nres)=c(j,k+nres)-aincr
10218 c(j,i+nres)=c(j,i+nres)+aincr
10219 dc(j,i+nres)=dc(j,i+nres)+aincr
10220 call etotal(energia1)
10222 ggg(j+3)=(etot1-etot)/aincr
10224 dc(j,i+nres)=ddx(j)
10226 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
10227 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
10230 end subroutine check_ecart
10231 !-----------------------------------------------------------------------------
10232 subroutine check_ecartint
10233 ! Check the gradient of the energy in Cartesian coordinates.
10234 use io_base, only: intout
10235 ! implicit real*8 (a-h,o-z)
10236 ! include 'DIMENSIONS'
10237 ! include 'COMMON.CONTROL'
10238 ! include 'COMMON.CHAIN'
10239 ! include 'COMMON.DERIV'
10240 ! include 'COMMON.IOUNITS'
10241 ! include 'COMMON.VAR'
10242 ! include 'COMMON.CONTACTS'
10243 ! include 'COMMON.MD'
10244 ! include 'COMMON.LOCAL'
10245 ! include 'COMMON.SPLITELE'
10247 !el integer :: icall
10248 !el common /srutu/ icall
10249 real(kind=8),dimension(6) :: ggg,ggg1
10250 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
10251 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10252 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
10253 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
10254 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
10255 real(kind=8),dimension(0:n_ene) :: energia,energia1
10256 integer :: uiparm(1)
10257 real(kind=8) :: urparm(1)
10259 integer :: i,j,k,nf
10260 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
10268 ! call intcartderiv
10269 ! call checkintcartgrad
10272 write(iout,*) 'Calling CHECK_ECARTINT.'
10275 call geom_to_var(nvar,x)
10276 if (.not.split_ene) then
10277 call etotal(energia)
10279 !el call enerprint(energia)
10281 write (iout,*) "enter cartgrad"
10284 write (iout,*) "exit cartgrad"
10288 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10291 grad_s(j,0)=gcart(j,0)
10295 grad_s(j,i)=gcart(j,i)
10296 grad_s(j+3,i)=gxcart(j,i)
10300 !- split gradient check
10302 call etotal_long(energia)
10303 !el call enerprint(energia)
10305 write (iout,*) "enter cartgrad"
10308 write (iout,*) "exit cartgrad"
10311 write (iout,*) "longrange grad"
10313 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10314 (gxcart(j,i),j=1,3)
10317 grad_s(j,0)=gcart(j,0)
10321 grad_s(j,i)=gcart(j,i)
10322 grad_s(j+3,i)=gxcart(j,i)
10326 call etotal_short(energia)
10327 !el call enerprint(energia)
10329 write (iout,*) "enter cartgrad"
10332 write (iout,*) "exit cartgrad"
10335 write (iout,*) "shortrange grad"
10337 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10338 (gxcart(j,i),j=1,3)
10341 grad_s1(j,0)=gcart(j,0)
10345 grad_s1(j,i)=gcart(j,i)
10346 grad_s1(j+3,i)=gxcart(j,i)
10350 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10355 ddx(j)=dc(j,i+nres)
10357 dcnorm_safe(k)=dc_norm(k,i)
10358 dxnorm_safe(k)=dc_norm(k,i+nres)
10362 dc(j,i)=ddc(j)+aincr
10363 call chainbuild_cart
10365 ! Broadcast the order to compute internal coordinates to the slaves.
10366 ! if (nfgtasks.gt.1)
10367 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
10369 ! call int_from_cart1(.false.)
10370 if (.not.split_ene) then
10371 call etotal(energia1)
10375 call etotal_long(energia1)
10377 call etotal_short(energia1)
10379 ! write (iout,*) "etot11",etot11," etot12",etot12
10381 !- end split gradient
10382 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10383 dc(j,i)=ddc(j)-aincr
10384 call chainbuild_cart
10385 ! call int_from_cart1(.false.)
10386 if (.not.split_ene) then
10387 call etotal(energia1)
10389 ggg(j)=(etot1-etot2)/(2*aincr)
10392 call etotal_long(energia1)
10394 ggg(j)=(etot11-etot21)/(2*aincr)
10395 call etotal_short(energia1)
10397 ggg1(j)=(etot12-etot22)/(2*aincr)
10398 !- end split gradient
10399 ! write (iout,*) "etot21",etot21," etot22",etot22
10401 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10403 call chainbuild_cart
10406 dc(j,i+nres)=ddx(j)+aincr
10407 call chainbuild_cart
10408 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
10409 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
10410 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
10411 ! write (iout,*) "dxnormnorm",dsqrt(
10412 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
10413 ! write (iout,*) "dxnormnormsafe",dsqrt(
10414 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
10416 if (.not.split_ene) then
10417 call etotal(energia1)
10421 call etotal_long(energia1)
10423 call etotal_short(energia1)
10426 !- end split gradient
10427 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10428 dc(j,i+nres)=ddx(j)-aincr
10429 call chainbuild_cart
10430 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
10431 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
10432 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
10434 ! write (iout,*) "dxnormnorm",dsqrt(
10435 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
10436 ! write (iout,*) "dxnormnormsafe",dsqrt(
10437 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
10438 if (.not.split_ene) then
10439 call etotal(energia1)
10441 ggg(j+3)=(etot1-etot2)/(2*aincr)
10444 call etotal_long(energia1)
10446 ggg(j+3)=(etot11-etot21)/(2*aincr)
10447 call etotal_short(energia1)
10449 ggg1(j+3)=(etot12-etot22)/(2*aincr)
10450 !- end split gradient
10452 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10453 dc(j,i+nres)=ddx(j)
10454 call chainbuild_cart
10456 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10457 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
10458 if (split_ene) then
10459 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10460 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
10462 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10463 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
10464 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
10468 end subroutine check_ecartint
10469 !-----------------------------------------------------------------------------
10470 subroutine check_eint
10471 ! Check the gradient of energy in internal coordinates.
10472 ! implicit real*8 (a-h,o-z)
10473 ! include 'DIMENSIONS'
10474 ! include 'COMMON.CHAIN'
10475 ! include 'COMMON.DERIV'
10476 ! include 'COMMON.IOUNITS'
10477 ! include 'COMMON.VAR'
10478 ! include 'COMMON.GEO'
10480 !el integer :: icall
10481 !el common /srutu/ icall
10482 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
10483 integer :: uiparm(1)
10484 real(kind=8) :: urparm(1)
10485 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
10486 character(len=6) :: key
10489 real(kind=8) :: xi,aincr,etot,etot1,etot2
10492 print '(a)','Calling CHECK_INT.'
10496 call geom_to_var(nvar,x)
10497 call var_to_geom(nvar,x)
10501 call etotal(energia)
10503 !el call enerprint(energia)
10506 if (MyID.ne.BossID) then
10507 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
10515 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
10516 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
10517 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
10521 x(i)=xi-0.5D0*aincr
10522 call var_to_geom(nvar,x)
10524 call etotal(energia1)
10526 x(i)=xi+0.5D0*aincr
10527 call var_to_geom(nvar,x)
10529 call etotal(energia2)
10531 gg(i)=(etot2-etot1)/aincr
10532 write (iout,*) i,etot1,etot2
10535 write (iout,'(/2a)')' Variable Numerical Analytical',&
10538 if (i.le.nphi) then
10541 else if (i.le.nphi+ntheta) then
10544 else if (i.le.nphi+ntheta+nside) then
10548 ii=i-(nphi+ntheta+nside)
10551 write (iout,'(i3,a,i3,3(1pd16.6))') &
10552 i,key,ii,gg(i),gana(i),&
10553 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
10556 end subroutine check_eint
10557 !-----------------------------------------------------------------------------
10559 !-----------------------------------------------------------------------------
10560 subroutine Econstr_back
10561 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
10562 ! implicit real*8 (a-h,o-z)
10563 ! include 'DIMENSIONS'
10564 ! include 'COMMON.CONTROL'
10565 ! include 'COMMON.VAR'
10566 ! include 'COMMON.MD'
10569 ! include 'COMMON.LANGEVIN'
10571 ! include 'COMMON.LANGEVIN.lang0'
10573 ! include 'COMMON.CHAIN'
10574 ! include 'COMMON.DERIV'
10575 ! include 'COMMON.GEO'
10576 ! include 'COMMON.LOCAL'
10577 ! include 'COMMON.INTERACT'
10578 ! include 'COMMON.IOUNITS'
10579 ! include 'COMMON.NAMES'
10580 ! include 'COMMON.TIME1'
10581 integer :: i,j,ii,k
10582 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
10584 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
10585 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
10586 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
10593 duscdiff(j,i)=0.0d0
10594 duscdiffx(j,i)=0.0d0
10598 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
10600 ! Deviations from theta angles
10603 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
10604 dtheta_i=theta(j)-thetaref(j)
10605 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
10606 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
10608 utheta(i)=utheta_i/(ii-1)
10610 ! Deviations from gamma angles
10613 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
10614 dgamma_i=pinorm(phi(j)-phiref(j))
10615 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
10616 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
10617 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
10618 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
10620 ugamma(i)=ugamma_i/(ii-2)
10622 ! Deviations from local SC geometry
10625 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
10626 dxx=xxtab(j)-xxref(j)
10627 dyy=yytab(j)-yyref(j)
10628 dzz=zztab(j)-zzref(j)
10629 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
10631 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
10632 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
10634 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
10635 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
10637 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
10638 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
10641 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
10642 ! & xxref(j),yyref(j),zzref(j)
10644 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
10645 ! write (iout,*) i," uscdiff",uscdiff(i)
10647 ! Put together deviations from local geometry
10649 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
10650 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
10651 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
10652 ! & " uconst_back",uconst_back
10653 utheta(i)=dsqrt(utheta(i))
10654 ugamma(i)=dsqrt(ugamma(i))
10655 uscdiff(i)=dsqrt(uscdiff(i))
10658 end subroutine Econstr_back
10659 !-----------------------------------------------------------------------------
10660 ! energy_p_new-sep_barrier.F
10661 !-----------------------------------------------------------------------------
10662 real(kind=8) function sscale(r)
10663 ! include "COMMON.SPLITELE"
10664 real(kind=8) :: r,gamm
10665 if(r.lt.r_cut-rlamb) then
10667 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10668 gamm=(r-(r_cut-rlamb))/rlamb
10669 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
10674 end function sscale
10675 !-----------------------------------------------------------------------------
10676 subroutine elj_long(evdw)
10678 ! This subroutine calculates the interaction energy of nonbonded side chains
10679 ! assuming the LJ potential of interaction.
10681 ! implicit real*8 (a-h,o-z)
10682 ! include 'DIMENSIONS'
10683 ! include 'COMMON.GEO'
10684 ! include 'COMMON.VAR'
10685 ! include 'COMMON.LOCAL'
10686 ! include 'COMMON.CHAIN'
10687 ! include 'COMMON.DERIV'
10688 ! include 'COMMON.INTERACT'
10689 ! include 'COMMON.TORSION'
10690 ! include 'COMMON.SBRIDGE'
10691 ! include 'COMMON.NAMES'
10692 ! include 'COMMON.IOUNITS'
10693 ! include 'COMMON.CONTACTS'
10694 real(kind=8),parameter :: accur=1.0d-10
10695 real(kind=8),dimension(3) :: gg
10696 !el local variables
10697 integer :: i,iint,j,k,itypi,itypi1,itypj
10698 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
10699 real(kind=8) :: e1,e2,evdwij,evdw
10700 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
10702 do i=iatsc_s,iatsc_e
10704 if (itypi.eq.ntyp1) cycle
10710 ! Calculate SC interaction energy.
10712 do iint=1,nint_gr(i)
10713 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
10714 !d & 'iend=',iend(i,iint)
10715 do j=istart(i,iint),iend(i,iint)
10717 if (itypj.eq.ntyp1) cycle
10721 rij=xj*xj+yj*yj+zj*zj
10722 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
10723 if (sss.lt.1.0d0) then
10725 eps0ij=eps(itypi,itypj)
10727 e1=fac*fac*aa(itypi,itypj)
10728 e2=fac*bb(itypi,itypj)
10730 evdw=evdw+(1.0d0-sss)*evdwij
10732 ! Calculate the components of the gradient in DC and X
10734 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
10739 gvdwx(k,i)=gvdwx(k,i)-gg(k)
10740 gvdwx(k,j)=gvdwx(k,j)+gg(k)
10741 gvdwc(k,i)=gvdwc(k,i)-gg(k)
10742 gvdwc(k,j)=gvdwc(k,j)+gg(k)
10750 gvdwc(j,i)=expon*gvdwc(j,i)
10751 gvdwx(j,i)=expon*gvdwx(j,i)
10754 !******************************************************************************
10758 ! To save time, the factor of EXPON has been extracted from ALL components
10759 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
10762 !******************************************************************************
10764 end subroutine elj_long
10765 !-----------------------------------------------------------------------------
10766 subroutine elj_short(evdw)
10768 ! This subroutine calculates the interaction energy of nonbonded side chains
10769 ! assuming the LJ potential of interaction.
10771 ! implicit real*8 (a-h,o-z)
10772 ! include 'DIMENSIONS'
10773 ! include 'COMMON.GEO'
10774 ! include 'COMMON.VAR'
10775 ! include 'COMMON.LOCAL'
10776 ! include 'COMMON.CHAIN'
10777 ! include 'COMMON.DERIV'
10778 ! include 'COMMON.INTERACT'
10779 ! include 'COMMON.TORSION'
10780 ! include 'COMMON.SBRIDGE'
10781 ! include 'COMMON.NAMES'
10782 ! include 'COMMON.IOUNITS'
10783 ! include 'COMMON.CONTACTS'
10784 real(kind=8),parameter :: accur=1.0d-10
10785 real(kind=8),dimension(3) :: gg
10786 !el local variables
10787 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
10788 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
10789 real(kind=8) :: e1,e2,evdwij,evdw
10790 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
10792 do i=iatsc_s,iatsc_e
10794 if (itypi.eq.ntyp1) cycle
10802 ! Calculate SC interaction energy.
10804 do iint=1,nint_gr(i)
10805 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
10806 !d & 'iend=',iend(i,iint)
10807 do j=istart(i,iint),iend(i,iint)
10809 if (itypj.eq.ntyp1) cycle
10813 ! Change 12/1/95 to calculate four-body interactions
10814 rij=xj*xj+yj*yj+zj*zj
10815 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
10816 if (sss.gt.0.0d0) then
10818 eps0ij=eps(itypi,itypj)
10820 e1=fac*fac*aa(itypi,itypj)
10821 e2=fac*bb(itypi,itypj)
10823 evdw=evdw+sss*evdwij
10825 ! Calculate the components of the gradient in DC and X
10827 fac=-rrij*(e1+evdwij)*sss
10832 gvdwx(k,i)=gvdwx(k,i)-gg(k)
10833 gvdwx(k,j)=gvdwx(k,j)+gg(k)
10834 gvdwc(k,i)=gvdwc(k,i)-gg(k)
10835 gvdwc(k,j)=gvdwc(k,j)+gg(k)
10843 gvdwc(j,i)=expon*gvdwc(j,i)
10844 gvdwx(j,i)=expon*gvdwx(j,i)
10847 !******************************************************************************
10851 ! To save time, the factor of EXPON has been extracted from ALL components
10852 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
10855 !******************************************************************************
10857 end subroutine elj_short
10858 !-----------------------------------------------------------------------------
10859 subroutine eljk_long(evdw)
10861 ! This subroutine calculates the interaction energy of nonbonded side chains
10862 ! assuming the LJK potential of interaction.
10864 ! implicit real*8 (a-h,o-z)
10865 ! include 'DIMENSIONS'
10866 ! include 'COMMON.GEO'
10867 ! include 'COMMON.VAR'
10868 ! include 'COMMON.LOCAL'
10869 ! include 'COMMON.CHAIN'
10870 ! include 'COMMON.DERIV'
10871 ! include 'COMMON.INTERACT'
10872 ! include 'COMMON.IOUNITS'
10873 ! include 'COMMON.NAMES'
10874 real(kind=8),dimension(3) :: gg
10876 !el local variables
10877 integer :: i,iint,j,k,itypi,itypi1,itypj
10878 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
10879 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
10880 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
10882 do i=iatsc_s,iatsc_e
10884 if (itypi.eq.ntyp1) cycle
10890 ! Calculate SC interaction energy.
10892 do iint=1,nint_gr(i)
10893 do j=istart(i,iint),iend(i,iint)
10895 if (itypj.eq.ntyp1) cycle
10899 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
10900 fac_augm=rrij**expon
10901 e_augm=augm(itypi,itypj)*fac_augm
10902 r_inv_ij=dsqrt(rrij)
10904 sss=sscale(rij/sigma(itypi,itypj))
10905 if (sss.lt.1.0d0) then
10906 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
10907 fac=r_shift_inv**expon
10908 e1=fac*fac*aa(itypi,itypj)
10909 e2=fac*bb(itypi,itypj)
10910 evdwij=e_augm+e1+e2
10911 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
10912 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
10913 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
10914 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
10915 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
10916 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
10917 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
10918 evdw=evdw+(1.0d0-sss)*evdwij
10920 ! Calculate the components of the gradient in DC and X
10922 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
10923 fac=fac*(1.0d0-sss)
10928 gvdwx(k,i)=gvdwx(k,i)-gg(k)
10929 gvdwx(k,j)=gvdwx(k,j)+gg(k)
10930 gvdwc(k,i)=gvdwc(k,i)-gg(k)
10931 gvdwc(k,j)=gvdwc(k,j)+gg(k)
10939 gvdwc(j,i)=expon*gvdwc(j,i)
10940 gvdwx(j,i)=expon*gvdwx(j,i)
10944 end subroutine eljk_long
10945 !-----------------------------------------------------------------------------
10946 subroutine eljk_short(evdw)
10948 ! This subroutine calculates the interaction energy of nonbonded side chains
10949 ! assuming the LJK potential of interaction.
10951 ! implicit real*8 (a-h,o-z)
10952 ! include 'DIMENSIONS'
10953 ! include 'COMMON.GEO'
10954 ! include 'COMMON.VAR'
10955 ! include 'COMMON.LOCAL'
10956 ! include 'COMMON.CHAIN'
10957 ! include 'COMMON.DERIV'
10958 ! include 'COMMON.INTERACT'
10959 ! include 'COMMON.IOUNITS'
10960 ! include 'COMMON.NAMES'
10961 real(kind=8),dimension(3) :: gg
10963 !el local variables
10964 integer :: i,iint,j,k,itypi,itypi1,itypj
10965 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
10966 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
10967 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
10969 do i=iatsc_s,iatsc_e
10971 if (itypi.eq.ntyp1) cycle
10977 ! Calculate SC interaction energy.
10979 do iint=1,nint_gr(i)
10980 do j=istart(i,iint),iend(i,iint)
10982 if (itypj.eq.ntyp1) cycle
10986 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
10987 fac_augm=rrij**expon
10988 e_augm=augm(itypi,itypj)*fac_augm
10989 r_inv_ij=dsqrt(rrij)
10991 sss=sscale(rij/sigma(itypi,itypj))
10992 if (sss.gt.0.0d0) then
10993 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
10994 fac=r_shift_inv**expon
10995 e1=fac*fac*aa(itypi,itypj)
10996 e2=fac*bb(itypi,itypj)
10997 evdwij=e_augm+e1+e2
10998 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
10999 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11000 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
11001 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
11002 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
11003 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
11004 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
11005 evdw=evdw+sss*evdwij
11007 ! Calculate the components of the gradient in DC and X
11009 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
11015 gvdwx(k,i)=gvdwx(k,i)-gg(k)
11016 gvdwx(k,j)=gvdwx(k,j)+gg(k)
11017 gvdwc(k,i)=gvdwc(k,i)-gg(k)
11018 gvdwc(k,j)=gvdwc(k,j)+gg(k)
11026 gvdwc(j,i)=expon*gvdwc(j,i)
11027 gvdwx(j,i)=expon*gvdwx(j,i)
11031 end subroutine eljk_short
11032 !-----------------------------------------------------------------------------
11033 subroutine ebp_long(evdw)
11035 ! This subroutine calculates the interaction energy of nonbonded side chains
11036 ! assuming the Berne-Pechukas potential of interaction.
11039 ! implicit real*8 (a-h,o-z)
11040 ! include 'DIMENSIONS'
11041 ! include 'COMMON.GEO'
11042 ! include 'COMMON.VAR'
11043 ! include 'COMMON.LOCAL'
11044 ! include 'COMMON.CHAIN'
11045 ! include 'COMMON.DERIV'
11046 ! include 'COMMON.NAMES'
11047 ! include 'COMMON.INTERACT'
11048 ! include 'COMMON.IOUNITS'
11049 ! include 'COMMON.CALC'
11051 !el integer :: icall
11052 !el common /srutu/ icall
11053 ! double precision rrsave(maxdim)
11055 !el local variables
11056 integer :: iint,itypi,itypi1,itypj
11057 real(kind=8) :: rrij,xi,yi,zi,fac
11058 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
11060 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
11062 ! if (icall.eq.0) then
11068 do i=iatsc_s,iatsc_e
11070 if (itypi.eq.ntyp1) cycle
11075 dxi=dc_norm(1,nres+i)
11076 dyi=dc_norm(2,nres+i)
11077 dzi=dc_norm(3,nres+i)
11078 ! dsci_inv=dsc_inv(itypi)
11079 dsci_inv=vbld_inv(i+nres)
11081 ! Calculate SC interaction energy.
11083 do iint=1,nint_gr(i)
11084 do j=istart(i,iint),iend(i,iint)
11087 if (itypj.eq.ntyp1) cycle
11088 ! dscj_inv=dsc_inv(itypj)
11089 dscj_inv=vbld_inv(j+nres)
11090 chi1=chi(itypi,itypj)
11091 chi2=chi(itypj,itypi)
11098 alf12=0.5D0*(alf1+alf2)
11102 dxj=dc_norm(1,nres+j)
11103 dyj=dc_norm(2,nres+j)
11104 dzj=dc_norm(3,nres+j)
11105 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11107 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11109 if (sss.lt.1.0d0) then
11111 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
11113 ! Calculate whole angle-dependent part of epsilon and contributions
11114 ! to its derivatives
11115 fac=(rrij*sigsq)**expon2
11116 e1=fac*fac*aa(itypi,itypj)
11117 e2=fac*bb(itypi,itypj)
11118 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11119 eps2der=evdwij*eps3rt
11120 eps3der=evdwij*eps2rt
11121 evdwij=evdwij*eps2rt*eps3rt
11122 evdw=evdw+evdwij*(1.0d0-sss)
11124 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11125 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11126 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
11127 !d & restyp(itypi),i,restyp(itypj),j,
11128 !d & epsi,sigm,chi1,chi2,chip1,chip2,
11129 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
11130 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
11133 ! Calculate gradient components.
11134 e1=e1*eps1*eps2rt**2*eps3rt**2
11135 fac=-expon*(e1+evdwij)
11138 ! Calculate radial part of the gradient
11142 ! Calculate the angular part of the gradient and sum add the contributions
11143 ! to the appropriate components of the Cartesian gradient.
11144 call sc_grad_scale(1.0d0-sss)
11151 end subroutine ebp_long
11152 !-----------------------------------------------------------------------------
11153 subroutine ebp_short(evdw)
11155 ! This subroutine calculates the interaction energy of nonbonded side chains
11156 ! assuming the Berne-Pechukas potential of interaction.
11159 ! implicit real*8 (a-h,o-z)
11160 ! include 'DIMENSIONS'
11161 ! include 'COMMON.GEO'
11162 ! include 'COMMON.VAR'
11163 ! include 'COMMON.LOCAL'
11164 ! include 'COMMON.CHAIN'
11165 ! include 'COMMON.DERIV'
11166 ! include 'COMMON.NAMES'
11167 ! include 'COMMON.INTERACT'
11168 ! include 'COMMON.IOUNITS'
11169 ! include 'COMMON.CALC'
11171 !el integer :: icall
11172 !el common /srutu/ icall
11173 ! double precision rrsave(maxdim)
11175 !el local variables
11176 integer :: iint,itypi,itypi1,itypj
11177 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
11178 real(kind=8) :: sss,e1,e2,evdw
11180 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
11182 ! if (icall.eq.0) then
11188 do i=iatsc_s,iatsc_e
11190 if (itypi.eq.ntyp1) cycle
11195 dxi=dc_norm(1,nres+i)
11196 dyi=dc_norm(2,nres+i)
11197 dzi=dc_norm(3,nres+i)
11198 ! dsci_inv=dsc_inv(itypi)
11199 dsci_inv=vbld_inv(i+nres)
11201 ! Calculate SC interaction energy.
11203 do iint=1,nint_gr(i)
11204 do j=istart(i,iint),iend(i,iint)
11207 if (itypj.eq.ntyp1) cycle
11208 ! dscj_inv=dsc_inv(itypj)
11209 dscj_inv=vbld_inv(j+nres)
11210 chi1=chi(itypi,itypj)
11211 chi2=chi(itypj,itypi)
11218 alf12=0.5D0*(alf1+alf2)
11222 dxj=dc_norm(1,nres+j)
11223 dyj=dc_norm(2,nres+j)
11224 dzj=dc_norm(3,nres+j)
11225 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11227 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11229 if (sss.gt.0.0d0) then
11231 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
11233 ! Calculate whole angle-dependent part of epsilon and contributions
11234 ! to its derivatives
11235 fac=(rrij*sigsq)**expon2
11236 e1=fac*fac*aa(itypi,itypj)
11237 e2=fac*bb(itypi,itypj)
11238 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11239 eps2der=evdwij*eps3rt
11240 eps3der=evdwij*eps2rt
11241 evdwij=evdwij*eps2rt*eps3rt
11242 evdw=evdw+evdwij*sss
11244 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11245 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11246 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
11247 !d & restyp(itypi),i,restyp(itypj),j,
11248 !d & epsi,sigm,chi1,chi2,chip1,chip2,
11249 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
11250 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
11253 ! Calculate gradient components.
11254 e1=e1*eps1*eps2rt**2*eps3rt**2
11255 fac=-expon*(e1+evdwij)
11258 ! Calculate radial part of the gradient
11262 ! Calculate the angular part of the gradient and sum add the contributions
11263 ! to the appropriate components of the Cartesian gradient.
11264 call sc_grad_scale(sss)
11271 end subroutine ebp_short
11272 !-----------------------------------------------------------------------------
11273 subroutine egb_long(evdw)
11275 ! This subroutine calculates the interaction energy of nonbonded side chains
11276 ! assuming the Gay-Berne potential of interaction.
11279 ! implicit real*8 (a-h,o-z)
11280 ! include 'DIMENSIONS'
11281 ! include 'COMMON.GEO'
11282 ! include 'COMMON.VAR'
11283 ! include 'COMMON.LOCAL'
11284 ! include 'COMMON.CHAIN'
11285 ! include 'COMMON.DERIV'
11286 ! include 'COMMON.NAMES'
11287 ! include 'COMMON.INTERACT'
11288 ! include 'COMMON.IOUNITS'
11289 ! include 'COMMON.CALC'
11290 ! include 'COMMON.CONTROL'
11292 !el local variables
11293 integer :: iint,itypi,itypi1,itypj
11294 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
11295 real(kind=8) :: sss,e1,e2,evdw
11297 !cccc energy_dec=.false.
11298 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11301 ! if (icall.eq.0) lprn=.false.
11303 do i=iatsc_s,iatsc_e
11305 if (itypi.eq.ntyp1) cycle
11310 dxi=dc_norm(1,nres+i)
11311 dyi=dc_norm(2,nres+i)
11312 dzi=dc_norm(3,nres+i)
11313 ! dsci_inv=dsc_inv(itypi)
11314 dsci_inv=vbld_inv(i+nres)
11315 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
11316 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
11318 ! Calculate SC interaction energy.
11320 do iint=1,nint_gr(i)
11321 do j=istart(i,iint),iend(i,iint)
11324 if (itypj.eq.ntyp1) cycle
11325 ! dscj_inv=dsc_inv(itypj)
11326 dscj_inv=vbld_inv(j+nres)
11327 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
11328 ! & 1.0d0/vbld(j+nres)
11329 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
11330 sig0ij=sigma(itypi,itypj)
11331 chi1=chi(itypi,itypj)
11332 chi2=chi(itypj,itypi)
11339 alf12=0.5D0*(alf1+alf2)
11343 dxj=dc_norm(1,nres+j)
11344 dyj=dc_norm(2,nres+j)
11345 dzj=dc_norm(3,nres+j)
11346 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11348 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11350 if (sss.lt.1.0d0) then
11352 ! Calculate angle-dependent terms of energy and contributions to their
11356 sig=sig0ij*dsqrt(sigsq)
11357 rij_shift=1.0D0/rij-sig+sig0ij
11358 ! for diagnostics; uncomment
11359 ! rij_shift=1.2*sig0ij
11360 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11361 if (rij_shift.le.0.0D0) then
11363 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
11364 !d & restyp(itypi),i,restyp(itypj),j,
11365 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
11369 !---------------------------------------------------------------
11370 rij_shift=1.0D0/rij_shift
11371 fac=rij_shift**expon
11372 e1=fac*fac*aa(itypi,itypj)
11373 e2=fac*bb(itypi,itypj)
11374 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11375 eps2der=evdwij*eps3rt
11376 eps3der=evdwij*eps2rt
11377 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
11378 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
11379 evdwij=evdwij*eps2rt*eps3rt
11380 evdw=evdw+evdwij*(1.0d0-sss)
11382 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11383 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11384 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11385 restyp(itypi),i,restyp(itypj),j,&
11386 epsi,sigm,chi1,chi2,chip1,chip2,&
11387 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
11388 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11392 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
11394 ! if (energy_dec) write (iout,*) &
11395 ! 'evdw',i,j,evdwij,"egb_long"
11397 ! Calculate gradient components.
11398 e1=e1*eps1*eps2rt**2*eps3rt**2
11399 fac=-expon*(e1+evdwij)*rij_shift
11403 ! Calculate the radial part of the gradient
11407 ! Calculate angular part of the gradient.
11408 call sc_grad_scale(1.0d0-sss)
11413 ! write (iout,*) "Number of loop steps in EGB:",ind
11414 !ccc energy_dec=.false.
11416 end subroutine egb_long
11417 !-----------------------------------------------------------------------------
11418 subroutine egb_short(evdw)
11420 ! This subroutine calculates the interaction energy of nonbonded side chains
11421 ! assuming the Gay-Berne potential of interaction.
11424 ! implicit real*8 (a-h,o-z)
11425 ! include 'DIMENSIONS'
11426 ! include 'COMMON.GEO'
11427 ! include 'COMMON.VAR'
11428 ! include 'COMMON.LOCAL'
11429 ! include 'COMMON.CHAIN'
11430 ! include 'COMMON.DERIV'
11431 ! include 'COMMON.NAMES'
11432 ! include 'COMMON.INTERACT'
11433 ! include 'COMMON.IOUNITS'
11434 ! include 'COMMON.CALC'
11435 ! include 'COMMON.CONTROL'
11437 !el local variables
11438 integer :: iint,itypi,itypi1,itypj
11439 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
11440 real(kind=8) :: sss,e1,e2,evdw,rij_shift
11442 !cccc energy_dec=.false.
11443 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11446 ! if (icall.eq.0) lprn=.false.
11448 do i=iatsc_s,iatsc_e
11450 if (itypi.eq.ntyp1) cycle
11455 dxi=dc_norm(1,nres+i)
11456 dyi=dc_norm(2,nres+i)
11457 dzi=dc_norm(3,nres+i)
11458 ! dsci_inv=dsc_inv(itypi)
11459 dsci_inv=vbld_inv(i+nres)
11460 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
11461 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
11463 ! Calculate SC interaction energy.
11465 do iint=1,nint_gr(i)
11466 do j=istart(i,iint),iend(i,iint)
11469 if (itypj.eq.ntyp1) cycle
11470 ! dscj_inv=dsc_inv(itypj)
11471 dscj_inv=vbld_inv(j+nres)
11472 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
11473 ! & 1.0d0/vbld(j+nres)
11474 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
11475 sig0ij=sigma(itypi,itypj)
11476 chi1=chi(itypi,itypj)
11477 chi2=chi(itypj,itypi)
11484 alf12=0.5D0*(alf1+alf2)
11488 dxj=dc_norm(1,nres+j)
11489 dyj=dc_norm(2,nres+j)
11490 dzj=dc_norm(3,nres+j)
11491 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11493 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11495 if (sss.gt.0.0d0) then
11497 ! Calculate angle-dependent terms of energy and contributions to their
11501 sig=sig0ij*dsqrt(sigsq)
11502 rij_shift=1.0D0/rij-sig+sig0ij
11503 ! for diagnostics; uncomment
11504 ! rij_shift=1.2*sig0ij
11505 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11506 if (rij_shift.le.0.0D0) then
11508 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
11509 !d & restyp(itypi),i,restyp(itypj),j,
11510 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
11514 !---------------------------------------------------------------
11515 rij_shift=1.0D0/rij_shift
11516 fac=rij_shift**expon
11517 e1=fac*fac*aa(itypi,itypj)
11518 e2=fac*bb(itypi,itypj)
11519 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11520 eps2der=evdwij*eps3rt
11521 eps3der=evdwij*eps2rt
11522 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
11523 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
11524 evdwij=evdwij*eps2rt*eps3rt
11525 evdw=evdw+evdwij*sss
11527 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11528 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11529 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11530 restyp(itypi),i,restyp(itypj),j,&
11531 epsi,sigm,chi1,chi2,chip1,chip2,&
11532 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
11533 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11537 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
11539 ! if (energy_dec) write (iout,*) &
11540 ! 'evdw',i,j,evdwij,"egb_short"
11542 ! Calculate gradient components.
11543 e1=e1*eps1*eps2rt**2*eps3rt**2
11544 fac=-expon*(e1+evdwij)*rij_shift
11548 ! Calculate the radial part of the gradient
11552 ! Calculate angular part of the gradient.
11553 call sc_grad_scale(sss)
11558 ! write (iout,*) "Number of loop steps in EGB:",ind
11559 !ccc energy_dec=.false.
11561 end subroutine egb_short
11562 !-----------------------------------------------------------------------------
11563 subroutine egbv_long(evdw)
11565 ! This subroutine calculates the interaction energy of nonbonded side chains
11566 ! assuming the Gay-Berne-Vorobjev potential of interaction.
11569 ! implicit real*8 (a-h,o-z)
11570 ! include 'DIMENSIONS'
11571 ! include 'COMMON.GEO'
11572 ! include 'COMMON.VAR'
11573 ! include 'COMMON.LOCAL'
11574 ! include 'COMMON.CHAIN'
11575 ! include 'COMMON.DERIV'
11576 ! include 'COMMON.NAMES'
11577 ! include 'COMMON.INTERACT'
11578 ! include 'COMMON.IOUNITS'
11579 ! include 'COMMON.CALC'
11581 !el integer :: icall
11582 !el common /srutu/ icall
11584 !el local variables
11585 integer :: iint,itypi,itypi1,itypj
11586 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
11587 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
11589 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11592 ! if (icall.eq.0) lprn=.true.
11594 do i=iatsc_s,iatsc_e
11596 if (itypi.eq.ntyp1) cycle
11601 dxi=dc_norm(1,nres+i)
11602 dyi=dc_norm(2,nres+i)
11603 dzi=dc_norm(3,nres+i)
11604 ! dsci_inv=dsc_inv(itypi)
11605 dsci_inv=vbld_inv(i+nres)
11607 ! Calculate SC interaction energy.
11609 do iint=1,nint_gr(i)
11610 do j=istart(i,iint),iend(i,iint)
11613 if (itypj.eq.ntyp1) cycle
11614 ! dscj_inv=dsc_inv(itypj)
11615 dscj_inv=vbld_inv(j+nres)
11616 sig0ij=sigma(itypi,itypj)
11617 r0ij=r0(itypi,itypj)
11618 chi1=chi(itypi,itypj)
11619 chi2=chi(itypj,itypi)
11626 alf12=0.5D0*(alf1+alf2)
11630 dxj=dc_norm(1,nres+j)
11631 dyj=dc_norm(2,nres+j)
11632 dzj=dc_norm(3,nres+j)
11633 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11636 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11638 if (sss.lt.1.0d0) then
11640 ! Calculate angle-dependent terms of energy and contributions to their
11644 sig=sig0ij*dsqrt(sigsq)
11645 rij_shift=1.0D0/rij-sig+r0ij
11646 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11647 if (rij_shift.le.0.0D0) then
11652 !---------------------------------------------------------------
11653 rij_shift=1.0D0/rij_shift
11654 fac=rij_shift**expon
11655 e1=fac*fac*aa(itypi,itypj)
11656 e2=fac*bb(itypi,itypj)
11657 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11658 eps2der=evdwij*eps3rt
11659 eps3der=evdwij*eps2rt
11660 fac_augm=rrij**expon
11661 e_augm=augm(itypi,itypj)*fac_augm
11662 evdwij=evdwij*eps2rt*eps3rt
11663 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
11665 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11666 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11667 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11668 restyp(itypi),i,restyp(itypj),j,&
11669 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
11670 chi1,chi2,chip1,chip2,&
11671 eps1,eps2rt**2,eps3rt**2,&
11672 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11675 ! Calculate gradient components.
11676 e1=e1*eps1*eps2rt**2*eps3rt**2
11677 fac=-expon*(e1+evdwij)*rij_shift
11679 fac=rij*fac-2*expon*rrij*e_augm
11680 ! Calculate the radial part of the gradient
11684 ! Calculate angular part of the gradient.
11685 call sc_grad_scale(1.0d0-sss)
11690 end subroutine egbv_long
11691 !-----------------------------------------------------------------------------
11692 subroutine egbv_short(evdw)
11694 ! This subroutine calculates the interaction energy of nonbonded side chains
11695 ! assuming the Gay-Berne-Vorobjev potential of interaction.
11698 ! implicit real*8 (a-h,o-z)
11699 ! include 'DIMENSIONS'
11700 ! include 'COMMON.GEO'
11701 ! include 'COMMON.VAR'
11702 ! include 'COMMON.LOCAL'
11703 ! include 'COMMON.CHAIN'
11704 ! include 'COMMON.DERIV'
11705 ! include 'COMMON.NAMES'
11706 ! include 'COMMON.INTERACT'
11707 ! include 'COMMON.IOUNITS'
11708 ! include 'COMMON.CALC'
11710 !el integer :: icall
11711 !el common /srutu/ icall
11713 !el local variables
11714 integer :: iint,itypi,itypi1,itypj
11715 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
11716 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
11718 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11721 ! if (icall.eq.0) lprn=.true.
11723 do i=iatsc_s,iatsc_e
11725 if (itypi.eq.ntyp1) cycle
11730 dxi=dc_norm(1,nres+i)
11731 dyi=dc_norm(2,nres+i)
11732 dzi=dc_norm(3,nres+i)
11733 ! dsci_inv=dsc_inv(itypi)
11734 dsci_inv=vbld_inv(i+nres)
11736 ! Calculate SC interaction energy.
11738 do iint=1,nint_gr(i)
11739 do j=istart(i,iint),iend(i,iint)
11742 if (itypj.eq.ntyp1) cycle
11743 ! dscj_inv=dsc_inv(itypj)
11744 dscj_inv=vbld_inv(j+nres)
11745 sig0ij=sigma(itypi,itypj)
11746 r0ij=r0(itypi,itypj)
11747 chi1=chi(itypi,itypj)
11748 chi2=chi(itypj,itypi)
11755 alf12=0.5D0*(alf1+alf2)
11759 dxj=dc_norm(1,nres+j)
11760 dyj=dc_norm(2,nres+j)
11761 dzj=dc_norm(3,nres+j)
11762 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11765 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11767 if (sss.gt.0.0d0) then
11769 ! Calculate angle-dependent terms of energy and contributions to their
11773 sig=sig0ij*dsqrt(sigsq)
11774 rij_shift=1.0D0/rij-sig+r0ij
11775 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11776 if (rij_shift.le.0.0D0) then
11781 !---------------------------------------------------------------
11782 rij_shift=1.0D0/rij_shift
11783 fac=rij_shift**expon
11784 e1=fac*fac*aa(itypi,itypj)
11785 e2=fac*bb(itypi,itypj)
11786 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11787 eps2der=evdwij*eps3rt
11788 eps3der=evdwij*eps2rt
11789 fac_augm=rrij**expon
11790 e_augm=augm(itypi,itypj)*fac_augm
11791 evdwij=evdwij*eps2rt*eps3rt
11792 evdw=evdw+(evdwij+e_augm)*sss
11794 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11795 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11796 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11797 restyp(itypi),i,restyp(itypj),j,&
11798 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
11799 chi1,chi2,chip1,chip2,&
11800 eps1,eps2rt**2,eps3rt**2,&
11801 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11804 ! Calculate gradient components.
11805 e1=e1*eps1*eps2rt**2*eps3rt**2
11806 fac=-expon*(e1+evdwij)*rij_shift
11808 fac=rij*fac-2*expon*rrij*e_augm
11809 ! Calculate the radial part of the gradient
11813 ! Calculate angular part of the gradient.
11814 call sc_grad_scale(sss)
11819 end subroutine egbv_short
11820 !-----------------------------------------------------------------------------
11821 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
11823 ! This subroutine calculates the average interaction energy and its gradient
11824 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
11825 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
11826 ! The potential depends both on the distance of peptide-group centers and on
11827 ! the orientation of the CA-CA virtual bonds.
11829 ! implicit real*8 (a-h,o-z)
11835 ! include 'DIMENSIONS'
11836 ! include 'COMMON.CONTROL'
11837 ! include 'COMMON.SETUP'
11838 ! include 'COMMON.IOUNITS'
11839 ! include 'COMMON.GEO'
11840 ! include 'COMMON.VAR'
11841 ! include 'COMMON.LOCAL'
11842 ! include 'COMMON.CHAIN'
11843 ! include 'COMMON.DERIV'
11844 ! include 'COMMON.INTERACT'
11845 ! include 'COMMON.CONTACTS'
11846 ! include 'COMMON.TORSION'
11847 ! include 'COMMON.VECTORS'
11848 ! include 'COMMON.FFIELD'
11849 ! include 'COMMON.TIME1'
11850 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
11851 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
11852 real(kind=8),dimension(2,2) :: acipa !el,a_temp
11853 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
11854 real(kind=8),dimension(4) :: muij
11855 !el integer :: num_conti,j1,j2
11856 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
11857 !el dz_normi,xmedi,ymedi,zmedi
11858 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
11859 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
11860 !el num_conti,j1,j2
11861 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
11863 real(kind=8) :: scal_el=1.0d0
11865 real(kind=8) :: scal_el=0.5d0
11868 ! 13-go grudnia roku pamietnego...
11869 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
11870 0.0d0,1.0d0,0.0d0,&
11871 0.0d0,0.0d0,1.0d0/),shape(unmat))
11872 !el local variables
11874 real(kind=8) :: fac
11875 real(kind=8) :: dxj,dyj,dzj
11876 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
11878 ! allocate(num_cont_hb(nres)) !(maxres)
11879 !d write(iout,*) 'In EELEC'
11881 !d write(iout,*) 'Type',i
11882 !d write(iout,*) 'B1',B1(:,i)
11883 !d write(iout,*) 'B2',B2(:,i)
11884 !d write(iout,*) 'CC',CC(:,:,i)
11885 !d write(iout,*) 'DD',DD(:,:,i)
11886 !d write(iout,*) 'EE',EE(:,:,i)
11888 !d call check_vecgrad
11890 if (icheckgrad.eq.1) then
11892 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
11894 dc_norm(k,i)=dc(k,i)*fac
11896 ! write (iout,*) 'i',i,' fac',fac
11899 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
11900 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
11901 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
11902 ! call vec_and_deriv
11908 time_mat=time_mat+MPI_Wtime()-time01
11912 !d write (iout,*) 'i=',i
11914 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
11917 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
11918 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
11931 !d print '(a)','Enter EELEC'
11932 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
11933 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
11934 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
11936 gel_loc_loc(i)=0.0d0
11941 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
11943 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
11945 do i=iturn3_start,iturn3_end
11946 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1 &
11947 .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
11951 dx_normi=dc_norm(1,i)
11952 dy_normi=dc_norm(2,i)
11953 dz_normi=dc_norm(3,i)
11954 xmedi=c(1,i)+0.5d0*dxi
11955 ymedi=c(2,i)+0.5d0*dyi
11956 zmedi=c(3,i)+0.5d0*dzi
11958 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
11959 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
11960 num_cont_hb(i)=num_conti
11962 do i=iturn4_start,iturn4_end
11963 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
11964 .or. itype(i+3).eq.ntyp1 &
11965 .or. itype(i+4).eq.ntyp1) cycle
11969 dx_normi=dc_norm(1,i)
11970 dy_normi=dc_norm(2,i)
11971 dz_normi=dc_norm(3,i)
11972 xmedi=c(1,i)+0.5d0*dxi
11973 ymedi=c(2,i)+0.5d0*dyi
11974 zmedi=c(3,i)+0.5d0*dzi
11975 num_conti=num_cont_hb(i)
11976 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
11977 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
11978 call eturn4(i,eello_turn4)
11979 num_cont_hb(i)=num_conti
11982 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
11984 do i=iatel_s,iatel_e
11985 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
11989 dx_normi=dc_norm(1,i)
11990 dy_normi=dc_norm(2,i)
11991 dz_normi=dc_norm(3,i)
11992 xmedi=c(1,i)+0.5d0*dxi
11993 ymedi=c(2,i)+0.5d0*dyi
11994 zmedi=c(3,i)+0.5d0*dzi
11995 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
11996 num_conti=num_cont_hb(i)
11997 do j=ielstart(i),ielend(i)
11998 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
11999 call eelecij_scale(i,j,ees,evdw1,eel_loc)
12001 num_cont_hb(i)=num_conti
12003 ! write (iout,*) "Number of loop steps in EELEC:",ind
12005 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
12006 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
12008 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
12009 !cc eel_loc=eel_loc+eello_turn3
12010 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
12012 end subroutine eelec_scale
12013 !-----------------------------------------------------------------------------
12014 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
12015 ! implicit real*8 (a-h,o-z)
12018 ! include 'DIMENSIONS'
12022 ! include 'COMMON.CONTROL'
12023 ! include 'COMMON.IOUNITS'
12024 ! include 'COMMON.GEO'
12025 ! include 'COMMON.VAR'
12026 ! include 'COMMON.LOCAL'
12027 ! include 'COMMON.CHAIN'
12028 ! include 'COMMON.DERIV'
12029 ! include 'COMMON.INTERACT'
12030 ! include 'COMMON.CONTACTS'
12031 ! include 'COMMON.TORSION'
12032 ! include 'COMMON.VECTORS'
12033 ! include 'COMMON.FFIELD'
12034 ! include 'COMMON.TIME1'
12035 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
12036 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
12037 real(kind=8),dimension(2,2) :: acipa !el,a_temp
12038 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
12039 real(kind=8),dimension(4) :: muij
12040 !el integer :: num_conti,j1,j2
12041 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
12042 !el dz_normi,xmedi,ymedi,zmedi
12043 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
12044 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
12045 !el num_conti,j1,j2
12046 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
12048 real(kind=8) :: scal_el=1.0d0
12050 real(kind=8) :: scal_el=0.5d0
12053 ! 13-go grudnia roku pamietnego...
12054 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
12055 0.0d0,1.0d0,0.0d0,&
12056 0.0d0,0.0d0,1.0d0/),shape(unmat))
12057 !el local variables
12058 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m
12059 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
12060 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
12061 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
12062 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
12063 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
12064 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
12065 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
12066 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
12067 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
12068 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
12069 ecosam,ecosbm,ecosgm,ghalf,time00
12070 ! integer :: maxconts
12071 ! maxconts = nres/4
12072 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12073 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12074 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12075 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12076 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12077 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12078 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12079 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12080 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
12081 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
12082 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
12083 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
12084 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
12086 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
12087 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
12092 !d write (iout,*) "eelecij",i,j
12096 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
12097 aaa=app(iteli,itelj)
12098 bbb=bpp(iteli,itelj)
12099 ael6i=ael6(iteli,itelj)
12100 ael3i=ael3(iteli,itelj)
12104 dx_normj=dc_norm(1,j)
12105 dy_normj=dc_norm(2,j)
12106 dz_normj=dc_norm(3,j)
12107 xj=c(1,j)+0.5D0*dxj-xmedi
12108 yj=c(2,j)+0.5D0*dyj-ymedi
12109 zj=c(3,j)+0.5D0*dzj-zmedi
12110 rij=xj*xj+yj*yj+zj*zj
12114 ! For extracting the short-range part of Evdwpp
12115 sss=sscale(rij/rpp(iteli,itelj))
12119 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
12120 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
12121 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
12122 fac=cosa-3.0D0*cosb*cosg
12124 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
12125 if (j.eq.i+2) ev1=scal_el*ev1
12130 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
12133 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
12134 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
12136 evdw1=evdw1+evdwij*(1.0d0-sss)
12137 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
12138 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
12139 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
12140 !d & xmedi,ymedi,zmedi,xj,yj,zj
12142 if (energy_dec) then
12143 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
12144 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
12148 ! Calculate contributions to the Cartesian gradient.
12151 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)
12152 facel=-3*rrmij*(el1+eesij)
12158 ! Radial derivatives. First process both termini of the fragment (i,j)
12164 ! ghalf=0.5D0*ggg(k)
12165 ! gelc(k,i)=gelc(k,i)+ghalf
12166 ! gelc(k,j)=gelc(k,j)+ghalf
12168 ! 9/28/08 AL Gradient compotents will be summed only at the end
12170 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
12171 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
12174 ! Loop over residues i+1 thru j-1.
12178 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12185 ! ghalf=0.5D0*ggg(k)
12186 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
12187 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
12189 ! 9/28/08 AL Gradient compotents will be summed only at the end
12191 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12192 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12195 ! Loop over residues i+1 thru j-1.
12199 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
12203 facvdw=ev1+evdwij*(1.0d0-sss)
12206 fac=-3*rrmij*(facvdw+facvdw+facel)
12211 ! Radial derivatives. First process both termini of the fragment (i,j)
12217 ! ghalf=0.5D0*ggg(k)
12218 ! gelc(k,i)=gelc(k,i)+ghalf
12219 ! gelc(k,j)=gelc(k,j)+ghalf
12221 ! 9/28/08 AL Gradient compotents will be summed only at the end
12223 gelc_long(k,j)=gelc(k,j)+ggg(k)
12224 gelc_long(k,i)=gelc(k,i)-ggg(k)
12227 ! Loop over residues i+1 thru j-1.
12231 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12234 ! 9/28/08 AL Gradient compotents will be summed only at the end
12239 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12240 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12246 ecosa=2.0D0*fac3*fac1+fac4
12249 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
12250 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
12252 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
12253 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
12255 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
12256 !d & (dcosg(k),k=1,3)
12258 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
12261 ! ghalf=0.5D0*ggg(k)
12262 ! gelc(k,i)=gelc(k,i)+ghalf
12263 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
12264 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12265 ! gelc(k,j)=gelc(k,j)+ghalf
12266 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
12267 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12271 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12275 gelc(k,i)=gelc(k,i) &
12276 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
12277 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12278 gelc(k,j)=gelc(k,j) &
12279 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
12280 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12281 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
12282 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
12284 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
12285 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
12286 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
12288 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
12289 ! energy of a peptide unit is assumed in the form of a second-order
12290 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
12291 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
12292 ! are computed for EVERY pair of non-contiguous peptide groups.
12294 if (j.lt.nres-1) then
12305 muij(kkk)=mu(k,i)*mu(l,j)
12308 !d write (iout,*) 'EELEC: i',i,' j',j
12309 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
12310 !d write(iout,*) 'muij',muij
12311 ury=scalar(uy(1,i),erij)
12312 urz=scalar(uz(1,i),erij)
12313 vry=scalar(uy(1,j),erij)
12314 vrz=scalar(uz(1,j),erij)
12315 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
12316 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
12317 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
12318 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
12319 fac=dsqrt(-ael6i)*r3ij
12324 !d write (iout,'(4i5,4f10.5)')
12325 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
12326 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
12327 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
12328 !d & uy(:,j),uz(:,j)
12329 !d write (iout,'(4f10.5)')
12330 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
12331 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
12332 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
12333 !d write (iout,'(9f10.5/)')
12334 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
12335 ! Derivatives of the elements of A in virtual-bond vectors
12336 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
12338 uryg(k,1)=scalar(erder(1,k),uy(1,i))
12339 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
12340 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
12341 urzg(k,1)=scalar(erder(1,k),uz(1,i))
12342 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
12343 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
12344 vryg(k,1)=scalar(erder(1,k),uy(1,j))
12345 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
12346 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
12347 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
12348 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
12349 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
12351 ! Compute radial contributions to the gradient
12369 ! Add the contributions coming from er
12372 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
12373 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
12374 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
12375 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
12378 ! Derivatives in DC(i)
12379 !grad ghalf1=0.5d0*agg(k,1)
12380 !grad ghalf2=0.5d0*agg(k,2)
12381 !grad ghalf3=0.5d0*agg(k,3)
12382 !grad ghalf4=0.5d0*agg(k,4)
12383 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
12384 -3.0d0*uryg(k,2)*vry)!+ghalf1
12385 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
12386 -3.0d0*uryg(k,2)*vrz)!+ghalf2
12387 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
12388 -3.0d0*urzg(k,2)*vry)!+ghalf3
12389 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
12390 -3.0d0*urzg(k,2)*vrz)!+ghalf4
12391 ! Derivatives in DC(i+1)
12392 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
12393 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
12394 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
12395 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
12396 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
12397 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
12398 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
12399 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
12400 ! Derivatives in DC(j)
12401 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
12402 -3.0d0*vryg(k,2)*ury)!+ghalf1
12403 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
12404 -3.0d0*vrzg(k,2)*ury)!+ghalf2
12405 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
12406 -3.0d0*vryg(k,2)*urz)!+ghalf3
12407 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
12408 -3.0d0*vrzg(k,2)*urz)!+ghalf4
12409 ! Derivatives in DC(j+1) or DC(nres-1)
12410 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
12411 -3.0d0*vryg(k,3)*ury)
12412 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
12413 -3.0d0*vrzg(k,3)*ury)
12414 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
12415 -3.0d0*vryg(k,3)*urz)
12416 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
12417 -3.0d0*vrzg(k,3)*urz)
12418 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
12420 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
12433 aggi(k,l)=-aggi(k,l)
12434 aggi1(k,l)=-aggi1(k,l)
12435 aggj(k,l)=-aggj(k,l)
12436 aggj1(k,l)=-aggj1(k,l)
12439 if (j.lt.nres-1) then
12445 aggi(k,l)=-aggi(k,l)
12446 aggi1(k,l)=-aggi1(k,l)
12447 aggj(k,l)=-aggj(k,l)
12448 aggj1(k,l)=-aggj1(k,l)
12459 aggi(k,l)=-aggi(k,l)
12460 aggi1(k,l)=-aggi1(k,l)
12461 aggj(k,l)=-aggj(k,l)
12462 aggj1(k,l)=-aggj1(k,l)
12467 IF (wel_loc.gt.0.0d0) THEN
12468 ! Contribution to the local-electrostatic energy coming from the i-j pair
12469 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
12471 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
12473 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
12474 'eelloc',i,j,eel_loc_ij
12475 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
12477 eel_loc=eel_loc+eel_loc_ij
12478 ! Partial derivatives in virtual-bond dihedral angles gamma
12480 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
12481 a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
12482 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
12483 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
12484 a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
12485 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
12486 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
12488 ggg(l)=agg(l,1)*muij(1)+ &
12489 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
12490 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
12491 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
12492 !grad ghalf=0.5d0*ggg(l)
12493 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
12494 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
12498 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
12501 ! Remaining derivatives of eello
12503 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ &
12504 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
12505 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ &
12506 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
12507 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ &
12508 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
12509 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ &
12510 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
12513 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
12514 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
12515 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
12516 .and. num_conti.le.maxconts) then
12517 ! write (iout,*) i,j," entered corr"
12519 ! Calculate the contact function. The ith column of the array JCONT will
12520 ! contain the numbers of atoms that make contacts with the atom I (of numbers
12521 ! greater than I). The arrays FACONT and GACONT will contain the values of
12522 ! the contact function and its derivative.
12523 ! r0ij=1.02D0*rpp(iteli,itelj)
12524 ! r0ij=1.11D0*rpp(iteli,itelj)
12525 r0ij=2.20D0*rpp(iteli,itelj)
12526 ! r0ij=1.55D0*rpp(iteli,itelj)
12527 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
12528 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
12529 if (fcont.gt.0.0D0) then
12530 num_conti=num_conti+1
12531 if (num_conti.gt.maxconts) then
12532 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
12533 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
12534 ' will skip next contacts for this conf.',num_conti
12536 jcont_hb(num_conti,i)=j
12537 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
12538 !d & " jcont_hb",jcont_hb(num_conti,i)
12539 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
12540 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
12541 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
12543 d_cont(num_conti,i)=rij
12544 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
12545 ! --- Electrostatic-interaction matrix ---
12546 a_chuj(1,1,num_conti,i)=a22
12547 a_chuj(1,2,num_conti,i)=a23
12548 a_chuj(2,1,num_conti,i)=a32
12549 a_chuj(2,2,num_conti,i)=a33
12550 ! --- Gradient of rij
12552 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
12559 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
12560 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
12561 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
12562 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
12563 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
12568 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
12569 ! Calculate contact energies
12571 wij=cosa-3.0D0*cosb*cosg
12574 ! fac3=dsqrt(-ael6i)/r0ij**3
12575 fac3=dsqrt(-ael6i)*r3ij
12576 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
12577 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
12578 if (ees0tmp.gt.0) then
12579 ees0pij=dsqrt(ees0tmp)
12583 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
12584 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
12585 if (ees0tmp.gt.0) then
12586 ees0mij=dsqrt(ees0tmp)
12591 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
12592 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
12593 ! Diagnostics. Comment out or remove after debugging!
12594 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
12595 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
12596 ! ees0m(num_conti,i)=0.0D0
12598 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
12599 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
12600 ! Angular derivatives of the contact function
12601 ees0pij1=fac3/ees0pij
12602 ees0mij1=fac3/ees0mij
12603 fac3p=-3.0D0*fac3*rrmij
12604 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
12605 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
12607 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
12608 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
12609 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
12610 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
12611 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
12612 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
12613 ecosap=ecosa1+ecosa2
12614 ecosbp=ecosb1+ecosb2
12615 ecosgp=ecosg1+ecosg2
12616 ecosam=ecosa1-ecosa2
12617 ecosbm=ecosb1-ecosb2
12618 ecosgm=ecosg1-ecosg2
12627 facont_hb(num_conti,i)=fcont
12628 fprimcont=fprimcont/rij
12629 !d facont_hb(num_conti,i)=1.0D0
12630 ! Following line is for diagnostics.
12633 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
12634 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
12637 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
12638 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
12640 gggp(1)=gggp(1)+ees0pijp*xj
12641 gggp(2)=gggp(2)+ees0pijp*yj
12642 gggp(3)=gggp(3)+ees0pijp*zj
12643 gggm(1)=gggm(1)+ees0mijp*xj
12644 gggm(2)=gggm(2)+ees0mijp*yj
12645 gggm(3)=gggm(3)+ees0mijp*zj
12646 ! Derivatives due to the contact function
12647 gacont_hbr(1,num_conti,i)=fprimcont*xj
12648 gacont_hbr(2,num_conti,i)=fprimcont*yj
12649 gacont_hbr(3,num_conti,i)=fprimcont*zj
12652 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
12653 ! following the change of gradient-summation algorithm.
12655 !grad ghalfp=0.5D0*gggp(k)
12656 !grad ghalfm=0.5D0*gggm(k)
12657 gacontp_hb1(k,num_conti,i)= & !ghalfp
12658 +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
12659 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12660 gacontp_hb2(k,num_conti,i)= & !ghalfp
12661 +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
12662 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12663 gacontp_hb3(k,num_conti,i)=gggp(k)
12664 gacontm_hb1(k,num_conti,i)= &!ghalfm
12665 +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
12666 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12667 gacontm_hb2(k,num_conti,i)= & !ghalfm
12668 +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
12669 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12670 gacontm_hb3(k,num_conti,i)=gggm(k)
12673 endif ! num_conti.le.maxconts
12676 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
12679 ghalf=0.5d0*agg(l,k)
12680 aggi(l,k)=aggi(l,k)+ghalf
12681 aggi1(l,k)=aggi1(l,k)+agg(l,k)
12682 aggj(l,k)=aggj(l,k)+ghalf
12685 if (j.eq.nres-1 .and. i.lt.j-2) then
12688 aggj1(l,k)=aggj1(l,k)+agg(l,k)
12693 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
12695 end subroutine eelecij_scale
12696 !-----------------------------------------------------------------------------
12697 subroutine evdwpp_short(evdw1)
12701 ! implicit real*8 (a-h,o-z)
12702 ! include 'DIMENSIONS'
12703 ! include 'COMMON.CONTROL'
12704 ! include 'COMMON.IOUNITS'
12705 ! include 'COMMON.GEO'
12706 ! include 'COMMON.VAR'
12707 ! include 'COMMON.LOCAL'
12708 ! include 'COMMON.CHAIN'
12709 ! include 'COMMON.DERIV'
12710 ! include 'COMMON.INTERACT'
12711 ! include 'COMMON.CONTACTS'
12712 ! include 'COMMON.TORSION'
12713 ! include 'COMMON.VECTORS'
12714 ! include 'COMMON.FFIELD'
12715 real(kind=8),dimension(3) :: ggg
12716 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
12718 real(kind=8) :: scal_el=1.0d0
12720 real(kind=8) :: scal_el=0.5d0
12722 !el local variables
12723 integer :: i,j,k,iteli,itelj,num_conti
12724 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
12725 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
12726 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
12727 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
12730 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
12731 ! & " iatel_e_vdw",iatel_e_vdw
12733 do i=iatel_s_vdw,iatel_e_vdw
12734 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle
12738 dx_normi=dc_norm(1,i)
12739 dy_normi=dc_norm(2,i)
12740 dz_normi=dc_norm(3,i)
12741 xmedi=c(1,i)+0.5d0*dxi
12742 ymedi=c(2,i)+0.5d0*dyi
12743 zmedi=c(3,i)+0.5d0*dzi
12745 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
12746 ! & ' ielend',ielend_vdw(i)
12748 do j=ielstart_vdw(i),ielend_vdw(i)
12749 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
12753 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
12754 aaa=app(iteli,itelj)
12755 bbb=bpp(iteli,itelj)
12759 dx_normj=dc_norm(1,j)
12760 dy_normj=dc_norm(2,j)
12761 dz_normj=dc_norm(3,j)
12762 xj=c(1,j)+0.5D0*dxj-xmedi
12763 yj=c(2,j)+0.5D0*dyj-ymedi
12764 zj=c(3,j)+0.5D0*dzj-zmedi
12765 rij=xj*xj+yj*yj+zj*zj
12768 sss=sscale(rij/rpp(iteli,itelj))
12769 if (sss.gt.0.0d0) then
12774 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
12775 if (j.eq.i+2) ev1=scal_el*ev1
12778 if (energy_dec) then
12779 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
12781 evdw1=evdw1+evdwij*sss
12783 ! Calculate contributions to the Cartesian gradient.
12785 facvdw=-6*rrmij*(ev1+evdwij)*sss
12790 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12791 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12797 end subroutine evdwpp_short
12798 !-----------------------------------------------------------------------------
12799 subroutine escp_long(evdw2,evdw2_14)
12801 ! This subroutine calculates the excluded-volume interaction energy between
12802 ! peptide-group centers and side chains and its gradient in virtual-bond and
12803 ! side-chain vectors.
12805 ! implicit real*8 (a-h,o-z)
12806 ! include 'DIMENSIONS'
12807 ! include 'COMMON.GEO'
12808 ! include 'COMMON.VAR'
12809 ! include 'COMMON.LOCAL'
12810 ! include 'COMMON.CHAIN'
12811 ! include 'COMMON.DERIV'
12812 ! include 'COMMON.INTERACT'
12813 ! include 'COMMON.FFIELD'
12814 ! include 'COMMON.IOUNITS'
12815 ! include 'COMMON.CONTROL'
12816 real(kind=8),dimension(3) :: ggg
12817 !el local variables
12818 integer :: i,iint,j,k,iteli,itypj
12819 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2
12820 real(kind=8) :: evdw2,evdw2_14,evdwij
12823 !d print '(a)','Enter ESCP'
12824 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
12825 do i=iatscp_s,iatscp_e
12826 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
12828 xi=0.5D0*(c(1,i)+c(1,i+1))
12829 yi=0.5D0*(c(2,i)+c(2,i+1))
12830 zi=0.5D0*(c(3,i)+c(3,i+1))
12832 do iint=1,nscp_gr(i)
12834 do j=iscpstart(i,iint),iscpend(i,iint)
12836 if (itypj.eq.ntyp1) cycle
12837 ! Uncomment following three lines for SC-p interactions
12838 ! xj=c(1,nres+j)-xi
12839 ! yj=c(2,nres+j)-yi
12840 ! zj=c(3,nres+j)-zi
12841 ! Uncomment following three lines for Ca-p interactions
12845 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12847 sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
12849 if (sss.lt.1.0d0) then
12852 e1=fac*fac*aad(itypj,iteli)
12853 e2=fac*bad(itypj,iteli)
12854 if (iabs(j-i) .le. 2) then
12857 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)
12860 evdw2=evdw2+evdwij*(1.0d0-sss)
12861 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
12862 'evdw2',i,j,sss,evdwij
12864 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
12866 fac=-(evdwij+e1)*rrij*(1.0d0-sss)
12870 ! Uncomment following three lines for SC-p interactions
12872 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
12874 ! Uncomment following line for SC-p interactions
12875 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
12877 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
12878 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
12887 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
12888 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
12889 gradx_scp(j,i)=expon*gradx_scp(j,i)
12892 !******************************************************************************
12896 ! To save time the factor EXPON has been extracted from ALL components
12897 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12900 !******************************************************************************
12902 end subroutine escp_long
12903 !-----------------------------------------------------------------------------
12904 subroutine escp_short(evdw2,evdw2_14)
12906 ! This subroutine calculates the excluded-volume interaction energy between
12907 ! peptide-group centers and side chains and its gradient in virtual-bond and
12908 ! side-chain vectors.
12910 ! implicit real*8 (a-h,o-z)
12911 ! include 'DIMENSIONS'
12912 ! include 'COMMON.GEO'
12913 ! include 'COMMON.VAR'
12914 ! include 'COMMON.LOCAL'
12915 ! include 'COMMON.CHAIN'
12916 ! include 'COMMON.DERIV'
12917 ! include 'COMMON.INTERACT'
12918 ! include 'COMMON.FFIELD'
12919 ! include 'COMMON.IOUNITS'
12920 ! include 'COMMON.CONTROL'
12921 real(kind=8),dimension(3) :: ggg
12922 !el local variables
12923 integer :: i,iint,j,k,iteli,itypj
12924 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2
12925 real(kind=8) :: evdw2,evdw2_14,evdwij
12928 !d print '(a)','Enter ESCP'
12929 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
12930 do i=iatscp_s,iatscp_e
12931 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
12933 xi=0.5D0*(c(1,i)+c(1,i+1))
12934 yi=0.5D0*(c(2,i)+c(2,i+1))
12935 zi=0.5D0*(c(3,i)+c(3,i+1))
12937 do iint=1,nscp_gr(i)
12939 do j=iscpstart(i,iint),iscpend(i,iint)
12941 if (itypj.eq.ntyp1) cycle
12942 ! Uncomment following three lines for SC-p interactions
12943 ! xj=c(1,nres+j)-xi
12944 ! yj=c(2,nres+j)-yi
12945 ! zj=c(3,nres+j)-zi
12946 ! Uncomment following three lines for Ca-p interactions
12950 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12952 sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
12954 if (sss.gt.0.0d0) then
12957 e1=fac*fac*aad(itypj,iteli)
12958 e2=fac*bad(itypj,iteli)
12959 if (iabs(j-i) .le. 2) then
12962 evdw2_14=evdw2_14+(e1+e2)*sss
12965 evdw2=evdw2+evdwij*sss
12966 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
12967 'evdw2',i,j,sss,evdwij
12969 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
12971 fac=-(evdwij+e1)*rrij*sss
12975 ! Uncomment following three lines for SC-p interactions
12977 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
12979 ! Uncomment following line for SC-p interactions
12980 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
12982 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
12983 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
12992 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
12993 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
12994 gradx_scp(j,i)=expon*gradx_scp(j,i)
12997 !******************************************************************************
13001 ! To save time the factor EXPON has been extracted from ALL components
13002 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
13005 !******************************************************************************
13007 end subroutine escp_short
13008 !-----------------------------------------------------------------------------
13009 ! energy_p_new-sep_barrier.F
13010 !-----------------------------------------------------------------------------
13011 subroutine sc_grad_scale(scalfac)
13012 ! implicit real*8 (a-h,o-z)
13014 ! include 'DIMENSIONS'
13015 ! include 'COMMON.CHAIN'
13016 ! include 'COMMON.DERIV'
13017 ! include 'COMMON.CALC'
13018 ! include 'COMMON.IOUNITS'
13019 real(kind=8),dimension(3) :: dcosom1,dcosom2
13020 real(kind=8) :: scalfac
13021 !el local variables
13022 ! integer :: i,j,k,l
13024 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
13025 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
13026 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
13027 -2.0D0*alf12*eps3der+sigder*sigsq_om12
13031 ! eom12=evdwij*eps1_om12
13033 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
13034 ! & " sigder",sigder
13035 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
13036 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
13038 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
13039 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
13042 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac
13044 ! write (iout,*) "gg",(gg(k),k=1,3)
13046 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
13047 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
13048 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac
13049 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
13050 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
13051 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac
13052 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
13053 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
13054 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
13055 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
13058 ! Calculate the components of the gradient in DC and X
13061 gvdwc(l,i)=gvdwc(l,i)-gg(l)
13062 gvdwc(l,j)=gvdwc(l,j)+gg(l)
13065 end subroutine sc_grad_scale
13066 !-----------------------------------------------------------------------------
13067 ! energy_split-sep.F
13068 !-----------------------------------------------------------------------------
13069 subroutine etotal_long(energia)
13071 ! Compute the long-range slow-varying contributions to the energy
13073 ! implicit real*8 (a-h,o-z)
13074 ! include 'DIMENSIONS'
13075 use MD_data, only: totT
13079 !MS$ATTRIBUTES C :: proc_proc
13084 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
13086 ! include 'COMMON.SETUP'
13087 ! include 'COMMON.IOUNITS'
13088 ! include 'COMMON.FFIELD'
13089 ! include 'COMMON.DERIV'
13090 ! include 'COMMON.INTERACT'
13091 ! include 'COMMON.SBRIDGE'
13092 ! include 'COMMON.CHAIN'
13093 ! include 'COMMON.VAR'
13094 ! include 'COMMON.LOCAL'
13095 ! include 'COMMON.MD'
13096 real(kind=8),dimension(0:n_ene) :: energia
13097 !el local variables
13098 integer :: i,n_corr,n_corr1,ierror,ierr
13099 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
13100 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
13101 ecorr,ecorr5,ecorr6,eturn6,time00
13102 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
13103 !elwrite(iout,*)"in etotal long"
13105 if (modecalc.eq.12.or.modecalc.eq.14) then
13107 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
13109 call int_from_cart1(.false.)
13112 !elwrite(iout,*)"in etotal long"
13115 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
13116 ! & " absolute rank",myrank," nfgtasks",nfgtasks
13118 if (nfgtasks.gt.1) then
13120 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
13121 if (fg_rank.eq.0) then
13122 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
13123 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
13125 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
13126 ! FG slaves as WEIGHTS array.
13133 weights_(7)=wel_loc
13136 weights_(10)=wturn6
13138 weights_(12)=wscloc
13140 weights_(14)=wtor_d
13141 weights_(15)=wstrain
13142 weights_(16)=wvdwpp
13144 weights_(18)=scal14
13145 weights_(21)=wsccor
13146 ! FG Master broadcasts the WEIGHTS_ array
13147 call MPI_Bcast(weights_(1),n_ene,&
13148 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13150 ! FG slaves receive the WEIGHTS array
13151 call MPI_Bcast(weights(1),n_ene,&
13152 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13167 wstrain=weights(15)
13173 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
13175 time_Bcast=time_Bcast+MPI_Wtime()-time00
13176 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
13177 ! call chainbuild_cart
13178 ! call int_from_cart1(.false.)
13180 ! write (iout,*) 'Processor',myrank,
13181 ! & ' calling etotal_short ipot=',ipot
13183 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
13185 !d print *,'nnt=',nnt,' nct=',nct
13187 !elwrite(iout,*)"in etotal long"
13188 ! Compute the side-chain and electrostatic interaction energy
13190 goto (101,102,103,104,105,106) ipot
13191 ! Lennard-Jones potential.
13192 101 call elj_long(evdw)
13193 !d print '(a)','Exit ELJ'
13195 ! Lennard-Jones-Kihara potential (shifted).
13196 102 call eljk_long(evdw)
13198 ! Berne-Pechukas potential (dilated LJ, angular dependence).
13199 103 call ebp_long(evdw)
13201 ! Gay-Berne potential (shifted LJ, angular dependence).
13202 104 call egb_long(evdw)
13204 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
13205 105 call egbv_long(evdw)
13207 ! Soft-sphere potential
13208 106 call e_softsphere(evdw)
13210 ! Calculate electrostatic (H-bonding) energy of the main chain.
13214 if (ipot.lt.6) then
13216 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
13217 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
13218 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
13219 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
13221 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
13222 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
13223 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
13224 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
13226 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13235 ! write (iout,*) "Soft-spheer ELEC potential"
13236 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
13240 ! Calculate excluded-volume interaction energy between peptide groups
13243 if (ipot.lt.6) then
13244 if(wscp.gt.0d0) then
13245 call escp_long(evdw2,evdw2_14)
13251 call escp_soft_sphere(evdw2,evdw2_14)
13254 ! 12/1/95 Multi-body terms
13258 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
13259 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
13260 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
13261 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
13262 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
13269 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
13270 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
13273 ! If performing constraint dynamics, call the constraint energy
13274 ! after the equilibration time
13275 if(usampl.and.totT.gt.eq_time) then
13290 energia(2)=evdw2-evdw2_14
13291 energia(18)=evdw2_14
13300 energia(3)=ees+evdw1
13307 energia(8)=eello_turn3
13308 energia(9)=eello_turn4
13310 energia(20)=Uconst+Uconst_back
13311 call sum_energy(energia,.true.)
13312 ! write (iout,*) "Exit ETOTAL_LONG"
13315 end subroutine etotal_long
13316 !-----------------------------------------------------------------------------
13317 subroutine etotal_short(energia)
13319 ! Compute the short-range fast-varying contributions to the energy
13321 ! implicit real*8 (a-h,o-z)
13322 ! include 'DIMENSIONS'
13326 !MS$ATTRIBUTES C :: proc_proc
13331 integer :: ierror,ierr
13332 real(kind=8),dimension(n_ene) :: weights_
13333 real(kind=8) :: time00
13335 ! include 'COMMON.SETUP'
13336 ! include 'COMMON.IOUNITS'
13337 ! include 'COMMON.FFIELD'
13338 ! include 'COMMON.DERIV'
13339 ! include 'COMMON.INTERACT'
13340 ! include 'COMMON.SBRIDGE'
13341 ! include 'COMMON.CHAIN'
13342 ! include 'COMMON.VAR'
13343 ! include 'COMMON.LOCAL'
13344 real(kind=8),dimension(0:n_ene) :: energia
13345 !el local variables
13347 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
13348 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr
13351 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
13353 if (modecalc.eq.12.or.modecalc.eq.14) then
13355 if (fg_rank.eq.0) call int_from_cart1(.false.)
13357 call int_from_cart1(.false.)
13361 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
13362 ! & " absolute rank",myrank," nfgtasks",nfgtasks
13364 if (nfgtasks.gt.1) then
13366 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
13367 if (fg_rank.eq.0) then
13368 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
13369 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
13371 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
13372 ! FG slaves as WEIGHTS array.
13379 weights_(7)=wel_loc
13382 weights_(10)=wturn6
13384 weights_(12)=wscloc
13386 weights_(14)=wtor_d
13387 weights_(15)=wstrain
13388 weights_(16)=wvdwpp
13390 weights_(18)=scal14
13391 weights_(21)=wsccor
13392 ! FG Master broadcasts the WEIGHTS_ array
13393 call MPI_Bcast(weights_(1),n_ene,&
13394 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13396 ! FG slaves receive the WEIGHTS array
13397 call MPI_Bcast(weights(1),n_ene,&
13398 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13413 wstrain=weights(15)
13419 ! write (iout,*),"Processor",myrank," BROADCAST weights"
13420 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
13422 ! write (iout,*) "Processor",myrank," BROADCAST c"
13423 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
13425 ! write (iout,*) "Processor",myrank," BROADCAST dc"
13426 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
13428 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
13429 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
13431 ! write (iout,*) "Processor",myrank," BROADCAST theta"
13432 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
13434 ! write (iout,*) "Processor",myrank," BROADCAST phi"
13435 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
13437 ! write (iout,*) "Processor",myrank," BROADCAST alph"
13438 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
13440 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
13441 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
13443 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
13444 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
13446 time_Bcast=time_Bcast+MPI_Wtime()-time00
13447 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
13449 ! write (iout,*) 'Processor',myrank,
13450 ! & ' calling etotal_short ipot=',ipot
13452 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
13454 ! call int_from_cart1(.false.)
13456 ! Compute the side-chain and electrostatic interaction energy
13458 goto (101,102,103,104,105,106) ipot
13459 ! Lennard-Jones potential.
13460 101 call elj_short(evdw)
13461 !d print '(a)','Exit ELJ'
13463 ! Lennard-Jones-Kihara potential (shifted).
13464 102 call eljk_short(evdw)
13466 ! Berne-Pechukas potential (dilated LJ, angular dependence).
13467 103 call ebp_short(evdw)
13469 ! Gay-Berne potential (shifted LJ, angular dependence).
13470 104 call egb_short(evdw)
13472 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
13473 105 call egbv_short(evdw)
13475 ! Soft-sphere potential - already dealt with in the long-range part
13477 ! 106 call e_softsphere_short(evdw)
13479 ! Calculate electrostatic (H-bonding) energy of the main chain.
13483 ! Calculate the short-range part of Evdwpp
13485 call evdwpp_short(evdw1)
13487 ! Calculate the short-range part of ESCp
13489 if (ipot.lt.6) then
13490 call escp_short(evdw2,evdw2_14)
13493 ! Calculate the bond-stretching energy
13497 ! Calculate the disulfide-bridge and other energy and the contributions
13498 ! from other distance constraints.
13501 ! Calculate the virtual-bond-angle energy.
13505 ! Calculate the SC local energy.
13510 ! Calculate the virtual-bond torsional energy.
13512 call etor(etors,edihcnstr)
13514 ! 6/23/01 Calculate double-torsional energy
13516 call etor_d(etors_d)
13518 ! 21/5/07 Calculate local sicdechain correlation energy
13520 if (wsccor.gt.0.0d0) then
13521 call eback_sc_corr(esccor)
13526 ! Put energy components into an array
13533 energia(2)=evdw2-evdw2_14
13534 energia(18)=evdw2_14
13547 energia(14)=etors_d
13550 energia(19)=edihcnstr
13552 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
13554 call sum_energy(energia,.true.)
13555 ! write (iout,*) "Exit ETOTAL_SHORT"
13558 end subroutine etotal_short
13559 !-----------------------------------------------------------------------------
13561 !-----------------------------------------------------------------------------
13562 real(kind=8) function gnmr1(y,ymin,ymax)
13564 real(kind=8) :: y,ymin,ymax
13565 real(kind=8) :: wykl=4.0d0
13566 if (y.lt.ymin) then
13567 gnmr1=(ymin-y)**wykl/wykl
13568 else if (y.gt.ymax) then
13569 gnmr1=(y-ymax)**wykl/wykl
13575 !-----------------------------------------------------------------------------
13576 real(kind=8) function gnmr1prim(y,ymin,ymax)
13578 real(kind=8) :: y,ymin,ymax
13579 real(kind=8) :: wykl=4.0d0
13580 if (y.lt.ymin) then
13581 gnmr1prim=-(ymin-y)**(wykl-1)
13582 else if (y.gt.ymax) then
13583 gnmr1prim=(y-ymax)**(wykl-1)
13588 end function gnmr1prim
13589 !-----------------------------------------------------------------------------
13590 real(kind=8) function harmonic(y,ymax)
13592 real(kind=8) :: y,ymax
13593 real(kind=8) :: wykl=2.0d0
13594 harmonic=(y-ymax)**wykl
13596 end function harmonic
13597 !-----------------------------------------------------------------------------
13598 real(kind=8) function harmonicprim(y,ymax)
13599 real(kind=8) :: y,ymin,ymax
13600 real(kind=8) :: wykl=2.0d0
13601 harmonicprim=(y-ymax)*wykl
13603 end function harmonicprim
13604 !-----------------------------------------------------------------------------
13606 !-----------------------------------------------------------------------------
13607 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
13609 use io_base, only:intout,briefout
13610 ! implicit real*8 (a-h,o-z)
13611 ! include 'DIMENSIONS'
13612 ! include 'COMMON.CHAIN'
13613 ! include 'COMMON.DERIV'
13614 ! include 'COMMON.VAR'
13615 ! include 'COMMON.INTERACT'
13616 ! include 'COMMON.FFIELD'
13617 ! include 'COMMON.MD'
13618 ! include 'COMMON.IOUNITS'
13619 real(kind=8),external :: ufparm
13620 integer :: uiparm(1)
13621 real(kind=8) :: urparm(1)
13622 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
13623 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
13624 integer :: n,nf,ind,ind1,i,k,j
13626 ! This subroutine calculates total internal coordinate gradient.
13627 ! Depending on the number of function evaluations, either whole energy
13628 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
13629 ! internal coordinates are reevaluated or only the cartesian-in-internal
13630 ! coordinate derivatives are evaluated. The subroutine was designed to work
13636 !d print *,'grad',nf,icg
13637 if (nf-nfl+1) 20,30,40
13638 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
13639 ! write (iout,*) 'grad 20'
13640 if (nf.eq.0) return
13642 30 call var_to_geom(n,x)
13644 ! write (iout,*) 'grad 30'
13646 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
13649 ! write (iout,*) 'grad 40'
13650 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
13652 ! Convert the Cartesian gradient into internal-coordinate gradient.
13662 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
13664 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
13667 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
13673 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
13675 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
13676 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
13679 if (i.gt.1) g(i-1)=gphii
13680 if (n.gt.nphi) g(nphi+i)=gthetai
13682 if (n.le.nphi+ntheta) goto 10
13684 if (itype(i).ne.10) then
13688 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
13691 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
13693 g(ialph(i,1))=galphai
13694 g(ialph(i,1)+nside)=gomegai
13698 ! Add the components corresponding to local energy terms.
13702 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
13703 g(i)=g(i)+gloc(i,icg)
13705 ! Uncomment following three lines for diagnostics.
13707 !elwrite(iout,*) "in gradient after calling intout"
13708 !d call briefout(0,0.0d0)
13709 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
13711 end subroutine gradient
13712 !-----------------------------------------------------------------------------
13713 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
13716 ! implicit real*8 (a-h,o-z)
13717 ! include 'DIMENSIONS'
13718 ! include 'COMMON.DERIV'
13719 ! include 'COMMON.IOUNITS'
13720 ! include 'COMMON.GEO'
13723 !el common /chuju/ jjj
13724 real(kind=8) :: energia(0:n_ene)
13725 integer :: uiparm(1)
13726 real(kind=8) :: urparm(1)
13728 real(kind=8),external :: ufparm
13729 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
13730 ! if (jjj.gt.0) then
13731 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
13735 !d print *,'func',nf,nfl,icg
13736 call var_to_geom(n,x)
13739 !d write (iout,*) 'ETOTAL called from FUNC'
13740 call etotal(energia)
13743 ! if (jjj.gt.0) then
13744 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
13745 ! write (iout,*) 'f=',etot
13749 end subroutine func
13750 !-----------------------------------------------------------------------------
13751 subroutine cartgrad
13752 ! implicit real*8 (a-h,o-z)
13753 ! include 'DIMENSIONS'
13755 use MD_data, only: totT
13759 ! include 'COMMON.CHAIN'
13760 ! include 'COMMON.DERIV'
13761 ! include 'COMMON.VAR'
13762 ! include 'COMMON.INTERACT'
13763 ! include 'COMMON.FFIELD'
13764 ! include 'COMMON.MD'
13765 ! include 'COMMON.IOUNITS'
13766 ! include 'COMMON.TIME1'
13770 ! This subrouting calculates total Cartesian coordinate gradient.
13771 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
13781 !el write (iout,*) "After sum_gradient"
13783 !el write (iout,*) "After sum_gradient"
13785 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
13786 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
13789 ! If performing constraint dynamics, add the gradients of the constraint energy
13790 if(usampl.and.totT.gt.eq_time) then
13793 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
13794 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
13798 gloc(i,icg)=gloc(i,icg)+dugamma(i)
13801 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
13804 !elwrite (iout,*) "After sum_gradient"
13809 !elwrite (iout,*) "After sum_gradient"
13811 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
13813 ! call checkintcartgrad
13814 ! write(iout,*) 'calling int_to_cart'
13816 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
13820 gcart(j,i)=gradc(j,i,icg)
13821 gxcart(j,i)=gradx(j,i,icg)
13824 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
13825 (gxcart(j,i),j=1,3),gloc(i,icg)
13833 time_inttocart=time_inttocart+MPI_Wtime()-time01
13836 write (iout,*) "gcart and gxcart after int_to_cart"
13838 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
13839 (gxcart(j,i),j=1,3)
13843 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
13847 end subroutine cartgrad
13848 !-----------------------------------------------------------------------------
13849 subroutine zerograd
13850 ! implicit real*8 (a-h,o-z)
13851 ! include 'DIMENSIONS'
13852 ! include 'COMMON.DERIV'
13853 ! include 'COMMON.CHAIN'
13854 ! include 'COMMON.VAR'
13855 ! include 'COMMON.MD'
13856 ! include 'COMMON.SCCOR'
13858 !el local variables
13859 integer :: i,j,intertyp
13860 ! Initialize Cartesian-coordinate gradient
13862 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
13863 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
13865 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
13866 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
13867 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
13868 ! allocate(gradcorr_long(3,nres))
13869 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
13870 ! allocate(gcorr6_turn_long(3,nres))
13871 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
13873 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
13875 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
13876 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
13878 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
13879 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
13881 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
13882 ! allocate(gscloc(3,nres)) !(3,maxres)
13883 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
13887 ! common /deriv_scloc/
13888 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
13889 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
13890 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
13892 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
13896 ! gradc(j,i,icg)=0.0d0
13897 ! gradx(j,i,icg)=0.0d0
13899 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
13900 !elwrite(iout,*) "icg",icg
13904 gradx_scp(j,i)=0.0D0
13906 gvdwc_scp(j,i)=0.0D0
13907 gvdwc_scpp(j,i)=0.0d0
13909 gelc_long(j,i)=0.0D0
13914 gel_loc_long(j,i)=0.0d0
13917 gcorr3_turn(j,i)=0.0d0
13918 gcorr4_turn(j,i)=0.0d0
13919 gradcorr(j,i)=0.0d0
13920 gradcorr_long(j,i)=0.0d0
13921 gradcorr5_long(j,i)=0.0d0
13922 gradcorr6_long(j,i)=0.0d0
13923 gcorr6_turn_long(j,i)=0.0d0
13924 gradcorr5(j,i)=0.0d0
13925 gradcorr6(j,i)=0.0d0
13926 gcorr6_turn(j,i)=0.0d0
13929 gradc(j,i,icg)=0.0d0
13930 gradx(j,i,icg)=0.0d0
13934 gloc_sc(intertyp,i,icg)=0.0d0
13939 ! Initialize the gradient of local energy terms.
13941 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
13942 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
13943 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
13944 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
13945 ! allocate(gel_loc_turn3(nres))
13946 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
13947 ! allocate(gsccor_loc(nres)) !(maxres)
13953 gel_loc_loc(i)=0.0d0
13955 g_corr5_loc(i)=0.0d0
13956 g_corr6_loc(i)=0.0d0
13957 gel_loc_turn3(i)=0.0d0
13958 gel_loc_turn4(i)=0.0d0
13959 gel_loc_turn6(i)=0.0d0
13960 gsccor_loc(i)=0.0d0
13962 ! initialize gcart and gxcart
13963 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
13971 end subroutine zerograd
13972 !-----------------------------------------------------------------------------
13973 real(kind=8) function fdum()
13977 !-----------------------------------------------------------------------------
13979 !-----------------------------------------------------------------------------
13980 subroutine intcartderiv
13981 ! implicit real*8 (a-h,o-z)
13982 ! include 'DIMENSIONS'
13986 ! include 'COMMON.SETUP'
13987 ! include 'COMMON.CHAIN'
13988 ! include 'COMMON.VAR'
13989 ! include 'COMMON.GEO'
13990 ! include 'COMMON.INTERACT'
13991 ! include 'COMMON.DERIV'
13992 ! include 'COMMON.IOUNITS'
13993 ! include 'COMMON.LOCAL'
13994 ! include 'COMMON.SCCOR'
13995 real(kind=8) :: pi4,pi34
13996 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
13997 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
13998 dcosomega,dsinomega !(3,3,maxres)
13999 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
14002 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
14003 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
14004 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
14005 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
14009 !el from module energy-------------
14010 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
14011 !el allocate(dsintau(3,3,3,itau_start:itau_end))
14012 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
14014 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
14015 !el allocate(dsintau(3,3,3,0:nres2))
14016 !el allocate(dtauangle(3,3,3,0:nres2))
14017 !el allocate(domicron(3,2,2,0:nres2))
14018 !el allocate(dcosomicron(3,2,2,0:nres2))
14022 #if defined(MPI) && defined(PARINTDER)
14023 if (nfgtasks.gt.1 .and. me.eq.king) &
14024 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
14029 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
14030 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
14032 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
14035 dtheta(j,1,i)=0.0d0
14036 dtheta(j,2,i)=0.0d0
14042 ! Derivatives of theta's
14043 #if defined(MPI) && defined(PARINTDER)
14044 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
14045 do i=max0(ithet_start-1,3),ithet_end
14049 cost=dcos(theta(i))
14050 sint=sqrt(1-cost*cost)
14052 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
14054 if (itype(i-1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
14055 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
14057 if (itype(i-1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
14060 #if defined(MPI) && defined(PARINTDER)
14061 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
14062 do i=max0(ithet_start-1,3),ithet_end
14066 if ((itype(i-1).ne.10).and.(itype(i-1).ne.ntyp1)) then
14067 cost1=dcos(omicron(1,i))
14068 sint1=sqrt(1-cost1*cost1)
14069 cost2=dcos(omicron(2,i))
14070 sint2=sqrt(1-cost2*cost2)
14072 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
14073 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
14074 cost1*dc_norm(j,i-2))/ &
14076 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
14077 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
14078 +cost1*(dc_norm(j,i-1+nres)))/ &
14080 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
14081 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
14082 !C Looks messy but better than if in loop
14083 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
14084 +cost2*dc_norm(j,i-1))/ &
14086 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
14087 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
14088 +cost2*(-dc_norm(j,i-1+nres)))/ &
14090 ! write(iout,*) "vbld", i,itype(i),vbld(i-1+nres)
14091 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
14095 !elwrite(iout,*) "after vbld write"
14096 ! Derivatives of phi:
14097 ! If phi is 0 or 180 degrees, then the formulas
14098 ! have to be derived by power series expansion of the
14099 ! conventional formulas around 0 and 180.
14101 do i=iphi1_start,iphi1_end
14105 ! if (itype(i-1).eq.21 .or. itype(i-2).eq.21 ) cycle
14106 ! the conventional case
14107 sint=dsin(theta(i))
14108 sint1=dsin(theta(i-1))
14110 cost=dcos(theta(i))
14111 cost1=dcos(theta(i-1))
14113 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
14114 fac0=1.0d0/(sint1*sint)
14117 fac3=cosg*cost1/(sint1*sint1)
14118 fac4=cosg*cost/(sint*sint)
14119 ! Obtaining the gamma derivatives from sine derivative
14120 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
14121 phi(i).gt.pi34.and.phi(i).le.pi.or. &
14122 phi(i).gt.-pi.and.phi(i).le.-pi34) then
14123 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
14124 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
14125 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
14129 cosg_inv=1.0d0/cosg
14130 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
14131 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
14132 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
14133 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
14135 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
14136 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14137 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
14138 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
14139 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
14140 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14141 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
14143 ! Bug fixed 3/24/05 (AL)
14145 ! Obtaining the gamma derivatives from cosine derivative
14148 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
14149 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
14150 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
14151 dc_norm(j,i-3))/vbld(i-2)
14152 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
14153 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
14154 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
14156 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
14157 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
14158 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
14159 dc_norm(j,i-1))/vbld(i)
14160 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
14165 !alculate derivative of Tauangle
14167 do i=itau_start,itau_end
14170 !elwrite(iout,*) " vecpr",i,nres
14172 if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
14173 ! if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10).or.
14174 ! & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1)) cycle
14175 !c dtauangle(j,intertyp,dervityp,residue number)
14176 !c INTERTYP=1 SC...Ca...Ca..Ca
14177 ! the conventional case
14178 sint=dsin(theta(i))
14179 sint1=dsin(omicron(2,i-1))
14180 sing=dsin(tauangle(1,i))
14181 cost=dcos(theta(i))
14182 cost1=dcos(omicron(2,i-1))
14183 cosg=dcos(tauangle(1,i))
14184 !elwrite(iout,*) " vecpr5",i,nres
14186 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
14187 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
14188 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
14189 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
14191 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
14192 fac0=1.0d0/(sint1*sint)
14195 fac3=cosg*cost1/(sint1*sint1)
14196 fac4=cosg*cost/(sint*sint)
14197 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
14198 ! Obtaining the gamma derivatives from sine derivative
14199 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
14200 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
14201 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
14202 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
14203 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
14204 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
14208 cosg_inv=1.0d0/cosg
14209 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
14210 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
14211 *vbld_inv(i-2+nres)
14212 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
14213 dsintau(j,1,2,i)= &
14214 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
14215 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14216 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
14217 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
14218 ! Bug fixed 3/24/05 (AL)
14219 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
14220 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
14221 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14222 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
14224 ! Obtaining the gamma derivatives from cosine derivative
14227 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
14228 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
14229 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
14230 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
14231 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
14232 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
14234 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
14235 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
14236 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
14237 dc_norm(j,i-1))/vbld(i)
14238 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
14239 ! write (iout,*) "else",i
14243 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
14246 !C Second case Ca...Ca...Ca...SC
14248 do i=itau_start,itau_end
14252 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
14253 (itype(i-2).eq.ntyp1).or.(itype(i-3).eq.ntyp1)) cycle
14254 ! the conventional case
14255 sint=dsin(omicron(1,i))
14256 sint1=dsin(theta(i-1))
14257 sing=dsin(tauangle(2,i))
14258 cost=dcos(omicron(1,i))
14259 cost1=dcos(theta(i-1))
14260 cosg=dcos(tauangle(2,i))
14262 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
14264 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
14265 fac0=1.0d0/(sint1*sint)
14268 fac3=cosg*cost1/(sint1*sint1)
14269 fac4=cosg*cost/(sint*sint)
14270 ! Obtaining the gamma derivatives from sine derivative
14271 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
14272 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
14273 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
14274 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
14275 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
14276 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
14280 cosg_inv=1.0d0/cosg
14281 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
14282 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
14283 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
14284 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
14285 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
14286 dsintau(j,2,2,i)= &
14287 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
14288 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14289 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
14290 ! & sing*ctgt*domicron(j,1,2,i),
14291 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14292 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
14293 ! Bug fixed 3/24/05 (AL)
14294 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
14295 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
14296 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14297 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
14299 ! Obtaining the gamma derivatives from cosine derivative
14302 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
14303 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
14304 dc_norm(j,i-3))/vbld(i-2)
14305 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
14306 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
14307 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
14308 dcosomicron(j,1,1,i)
14309 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
14310 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
14311 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
14312 dc_norm(j,i-1+nres))/vbld(i-1+nres)
14313 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
14314 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
14319 !CC third case SC...Ca...Ca...SC
14322 do i=itau_start,itau_end
14326 ! the conventional case
14327 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
14328 (itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
14329 sint=dsin(omicron(1,i))
14330 sint1=dsin(omicron(2,i-1))
14331 sing=dsin(tauangle(3,i))
14332 cost=dcos(omicron(1,i))
14333 cost1=dcos(omicron(2,i-1))
14334 cosg=dcos(tauangle(3,i))
14336 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
14337 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
14339 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
14340 fac0=1.0d0/(sint1*sint)
14343 fac3=cosg*cost1/(sint1*sint1)
14344 fac4=cosg*cost/(sint*sint)
14345 ! Obtaining the gamma derivatives from sine derivative
14346 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
14347 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
14348 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
14349 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
14350 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
14351 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
14355 cosg_inv=1.0d0/cosg
14356 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
14357 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
14358 *vbld_inv(i-2+nres)
14359 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
14360 dsintau(j,3,2,i)= &
14361 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
14362 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14363 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
14364 ! Bug fixed 3/24/05 (AL)
14365 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
14366 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
14367 *vbld_inv(i-1+nres)
14368 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14369 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
14371 ! Obtaining the gamma derivatives from cosine derivative
14374 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
14375 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
14376 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
14377 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
14378 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
14379 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
14380 dcosomicron(j,1,1,i)
14381 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
14382 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
14383 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
14384 dc_norm(j,i-1+nres))/vbld(i-1+nres)
14385 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
14386 ! write(iout,*) "else",i
14392 ! Derivatives of side-chain angles alpha and omega
14393 #if defined(MPI) && defined(PARINTDER)
14394 do i=ibond_start,ibond_end
14398 if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then
14399 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
14402 fac8=fac5/vbld(i+1)
14403 fac9=fac5/vbld(i+nres)
14404 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
14405 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
14406 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
14407 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
14408 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
14409 sina=sqrt(1-cosa*cosa)
14411 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
14413 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
14414 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
14415 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
14416 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
14417 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
14418 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
14419 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
14420 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
14422 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
14424 ! obtaining the derivatives of omega from sines
14425 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
14426 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
14427 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
14428 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
14430 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
14431 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
14432 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
14433 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
14434 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
14435 coso_inv=1.0d0/dcos(omeg(i))
14437 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
14438 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
14439 (sino*dc_norm(j,i-1))/vbld(i)
14440 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
14441 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
14442 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
14443 -sino*dc_norm(j,i)/vbld(i+1)
14444 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
14445 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
14446 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
14448 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
14451 ! obtaining the derivatives of omega from cosines
14452 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
14453 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
14458 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
14459 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
14460 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
14461 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
14462 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
14463 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
14464 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
14465 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
14466 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
14467 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
14468 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
14469 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
14470 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
14471 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
14472 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
14478 dalpha(k,j,i)=0.0d0
14479 domega(k,j,i)=0.0d0
14485 #if defined(MPI) && defined(PARINTDER)
14486 if (nfgtasks.gt.1) then
14488 !d write (iout,*) "Gather dtheta"
14489 !d call flush(iout)
14490 write (iout,*) "dtheta before gather"
14492 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
14495 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
14496 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
14497 king,FG_COMM,IERROR)
14499 !d write (iout,*) "Gather dphi"
14500 !d call flush(iout)
14501 write (iout,*) "dphi before gather"
14503 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
14506 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
14507 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
14508 king,FG_COMM,IERROR)
14509 !d write (iout,*) "Gather dalpha"
14510 !d call flush(iout)
14512 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
14513 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
14514 king,FG_COMM,IERROR)
14515 !d write (iout,*) "Gather domega"
14516 !d call flush(iout)
14517 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
14518 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
14519 king,FG_COMM,IERROR)
14524 write (iout,*) "dtheta after gather"
14526 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
14528 write (iout,*) "dphi after gather"
14530 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
14532 write (iout,*) "dalpha after gather"
14534 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
14536 write (iout,*) "domega after gather"
14538 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
14542 end subroutine intcartderiv
14543 !-----------------------------------------------------------------------------
14544 subroutine checkintcartgrad
14545 ! implicit real*8 (a-h,o-z)
14546 ! include 'DIMENSIONS'
14550 ! include 'COMMON.CHAIN'
14551 ! include 'COMMON.VAR'
14552 ! include 'COMMON.GEO'
14553 ! include 'COMMON.INTERACT'
14554 ! include 'COMMON.DERIV'
14555 ! include 'COMMON.IOUNITS'
14556 ! include 'COMMON.SETUP'
14557 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
14558 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
14559 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
14560 real(kind=8),dimension(3) :: dc_norm_s
14561 real(kind=8) :: aincr=1.0d-5
14563 real(kind=8) :: dcji
14566 theta_s(i)=theta(i)
14570 ! Check theta gradient
14572 "Analytical (upper) and numerical (lower) gradient of theta"
14577 dc(j,i-2)=dcji+aincr
14578 call chainbuild_cart
14579 call int_from_cart1(.false.)
14580 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
14583 dc(j,i-1)=dc(j,i-1)+aincr
14584 call chainbuild_cart
14585 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
14588 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
14589 !el (dtheta(j,2,i),j=1,3)
14590 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
14591 !el (dthetanum(j,2,i),j=1,3)
14592 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
14593 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
14594 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
14597 ! Check gamma gradient
14599 "Analytical (upper) and numerical (lower) gradient of gamma"
14603 dc(j,i-3)=dcji+aincr
14604 call chainbuild_cart
14605 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
14608 dc(j,i-2)=dcji+aincr
14609 call chainbuild_cart
14610 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
14613 dc(j,i-1)=dc(j,i-1)+aincr
14614 call chainbuild_cart
14615 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
14618 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
14619 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
14620 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
14621 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
14622 !el write (iout,'(5x,3(3f10.5,5x))') &
14623 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
14624 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
14625 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
14628 ! Check alpha gradient
14630 "Analytical (upper) and numerical (lower) gradient of alpha"
14632 if(itype(i).ne.10) then
14635 dc(j,i-1)=dcji+aincr
14636 call chainbuild_cart
14637 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
14642 call chainbuild_cart
14643 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
14647 dc(j,i+nres)=dc(j,i+nres)+aincr
14648 call chainbuild_cart
14649 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
14654 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
14655 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
14656 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
14657 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
14658 !el write (iout,'(5x,3(3f10.5,5x))') &
14659 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
14660 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
14661 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
14664 ! Check omega gradient
14666 "Analytical (upper) and numerical (lower) gradient of omega"
14668 if(itype(i).ne.10) then
14671 dc(j,i-1)=dcji+aincr
14672 call chainbuild_cart
14673 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
14678 call chainbuild_cart
14679 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
14683 dc(j,i+nres)=dc(j,i+nres)+aincr
14684 call chainbuild_cart
14685 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
14690 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
14691 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
14692 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
14693 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
14694 !el write (iout,'(5x,3(3f10.5,5x))') &
14695 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
14696 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
14697 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
14701 end subroutine checkintcartgrad
14702 !-----------------------------------------------------------------------------
14704 !-----------------------------------------------------------------------------
14705 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
14706 ! implicit real*8 (a-h,o-z)
14707 ! include 'DIMENSIONS'
14708 ! include 'COMMON.IOUNITS'
14709 ! include 'COMMON.CHAIN'
14710 ! include 'COMMON.INTERACT'
14711 ! include 'COMMON.VAR'
14712 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
14713 integer :: kkk,nsep=3
14714 real(kind=8) :: qm !dist,
14715 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
14716 logical :: lprn=.false.
14718 ! real(kind=8) :: sigm,x
14720 !el sigm(x)=0.25d0*x ! local function
14726 do il=seg1+nsep,seg2
14729 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
14730 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
14731 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
14733 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
14734 if (itype(il).ne.10 .or. itype(jl).ne.10) then
14737 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
14738 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
14739 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
14740 dijCM=dist(il+nres,jl+nres)
14741 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
14743 qq = qq+qqij+qqijCM
14749 if((seg3-il).lt.3) then
14756 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
14757 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
14758 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
14760 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
14761 if (itype(il).ne.10 .or. itype(jl).ne.10) then
14764 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
14765 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
14766 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
14767 dijCM=dist(il+nres,jl+nres)
14768 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
14770 qq = qq+qqij+qqijCM
14775 if (qqmax.le.qq) qqmax=qq
14777 qwolynes=1.0d0-qqmax
14779 end function qwolynes
14780 !-----------------------------------------------------------------------------
14781 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
14782 ! implicit real*8 (a-h,o-z)
14783 ! include 'DIMENSIONS'
14784 ! include 'COMMON.IOUNITS'
14785 ! include 'COMMON.CHAIN'
14786 ! include 'COMMON.INTERACT'
14787 ! include 'COMMON.VAR'
14788 ! include 'COMMON.MD'
14789 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
14790 integer :: nsep=3, kkk
14791 !el real(kind=8) :: dist
14792 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
14793 logical :: lprn=.false.
14795 real(kind=8) :: sim,dd0,fac,ddqij
14796 !el sigm(x)=0.25d0*x ! local function
14806 do il=seg1+nsep,seg2
14809 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
14810 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
14811 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
14813 sim = 1.0d0/sigm(d0ij)
14816 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
14818 ddqij = (c(k,il)-c(k,jl))*fac
14819 dqwol(k,il)=dqwol(k,il)+ddqij
14820 dqwol(k,jl)=dqwol(k,jl)-ddqij
14823 if (itype(il).ne.10 .or. itype(jl).ne.10) then
14826 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
14827 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
14828 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
14829 dijCM=dist(il+nres,jl+nres)
14830 sim = 1.0d0/sigm(d0ijCM)
14833 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
14835 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
14836 dxqwol(k,il)=dxqwol(k,il)+ddqij
14837 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
14844 if((seg3-il).lt.3) then
14851 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
14852 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
14853 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
14855 sim = 1.0d0/sigm(d0ij)
14858 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
14860 ddqij = (c(k,il)-c(k,jl))*fac
14861 dqwol(k,il)=dqwol(k,il)+ddqij
14862 dqwol(k,jl)=dqwol(k,jl)-ddqij
14864 if (itype(il).ne.10 .or. itype(jl).ne.10) then
14867 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
14868 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
14869 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
14870 dijCM=dist(il+nres,jl+nres)
14871 sim = 1.0d0/sigm(d0ijCM)
14874 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
14876 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
14877 dxqwol(k,il)=dxqwol(k,il)+ddqij
14878 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
14887 dqwol(j,i)=dqwol(j,i)/nl
14888 dxqwol(j,i)=dxqwol(j,i)/nl
14892 end subroutine qwolynes_prim
14893 !-----------------------------------------------------------------------------
14894 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
14895 ! implicit real*8 (a-h,o-z)
14896 ! include 'DIMENSIONS'
14897 ! include 'COMMON.IOUNITS'
14898 ! include 'COMMON.CHAIN'
14899 ! include 'COMMON.INTERACT'
14900 ! include 'COMMON.VAR'
14901 integer :: seg1,seg2,seg3,seg4
14903 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
14904 real(kind=8),dimension(3,0:2*nres) :: cdummy
14905 real(kind=8) :: q1,q2
14906 real(kind=8) :: delta=1.0d-10
14911 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
14913 c(j,i)=c(j,i)+delta
14914 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
14915 qwolan(j,i)=(q2-q1)/delta
14921 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
14922 cdummy(j,i+nres)=c(j,i+nres)
14923 c(j,i+nres)=c(j,i+nres)+delta
14924 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
14925 qwolxan(j,i)=(q2-q1)/delta
14926 c(j,i+nres)=cdummy(j,i+nres)
14929 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
14931 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
14933 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
14935 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
14938 end subroutine qwol_num
14939 !-----------------------------------------------------------------------------
14940 subroutine EconstrQ
14941 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
14942 ! implicit real*8 (a-h,o-z)
14943 ! include 'DIMENSIONS'
14944 ! include 'COMMON.CONTROL'
14945 ! include 'COMMON.VAR'
14946 ! include 'COMMON.MD'
14949 ! include 'COMMON.LANGEVIN'
14951 ! include 'COMMON.LANGEVIN.lang0'
14953 ! include 'COMMON.CHAIN'
14954 ! include 'COMMON.DERIV'
14955 ! include 'COMMON.GEO'
14956 ! include 'COMMON.LOCAL'
14957 ! include 'COMMON.INTERACT'
14958 ! include 'COMMON.IOUNITS'
14959 ! include 'COMMON.NAMES'
14960 ! include 'COMMON.TIME1'
14961 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
14962 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
14964 integer :: kstart,kend,lstart,lend,idummy
14965 real(kind=8) :: delta=1.0d-7
14966 integer :: i,j,k,ii
14970 dudconst(j,i)=0.0d0
14971 duxconst(j,i)=0.0d0
14972 dudxconst(j,i)=0.0d0
14977 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
14979 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
14980 ! Calculating the derivatives of Constraint energy with respect to Q
14981 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
14983 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
14984 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
14985 ! hmnum=(hm2-hm1)/delta
14986 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
14987 ! & qinfrag(i,iset))
14988 ! write(iout,*) "harmonicnum frag", hmnum
14989 ! Calculating the derivatives of Q with respect to cartesian coordinates
14990 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
14992 ! write(iout,*) "dqwol "
14994 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
14996 ! write(iout,*) "dxqwol "
14998 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
15000 ! Calculating numerical gradients of dU/dQi and dQi/dxi
15001 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
15002 ! & ,idummy,idummy)
15003 ! The gradients of Uconst in Cs
15006 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
15007 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
15012 kstart=ifrag(1,ipair(1,i,iset),iset)
15013 kend=ifrag(2,ipair(1,i,iset),iset)
15014 lstart=ifrag(1,ipair(2,i,iset),iset)
15015 lend=ifrag(2,ipair(2,i,iset),iset)
15016 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
15017 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
15018 ! Calculating dU/dQ
15019 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
15020 ! hm1=harmonic(qpair(i),qinpair(i,iset))
15021 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
15022 ! hmnum=(hm2-hm1)/delta
15023 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
15024 ! & qinpair(i,iset))
15025 ! write(iout,*) "harmonicnum pair ", hmnum
15026 ! Calculating dQ/dXi
15027 call qwolynes_prim(kstart,kend,.false.,&
15029 ! write(iout,*) "dqwol "
15031 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
15033 ! write(iout,*) "dxqwol "
15035 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
15037 ! Calculating numerical gradients
15038 ! call qwol_num(kstart,kend,.false.
15040 ! The gradients of Uconst in Cs
15043 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
15044 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
15048 ! write(iout,*) "Uconst inside subroutine ", Uconst
15049 ! Transforming the gradients from Cs to dCs for the backbone
15053 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
15057 ! Transforming the gradients from Cs to dCs for the side chains
15060 dudxconst(j,i)=duxconst(j,i)
15063 ! write(iout,*) "dU/ddc backbone "
15065 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
15067 ! write(iout,*) "dU/ddX side chain "
15069 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
15071 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
15072 ! call dEconstrQ_num
15074 end subroutine EconstrQ
15075 !-----------------------------------------------------------------------------
15076 subroutine dEconstrQ_num
15077 ! Calculating numerical dUconst/ddc and dUconst/ddx
15078 ! implicit real*8 (a-h,o-z)
15079 ! include 'DIMENSIONS'
15080 ! include 'COMMON.CONTROL'
15081 ! include 'COMMON.VAR'
15082 ! include 'COMMON.MD'
15085 ! include 'COMMON.LANGEVIN'
15087 ! include 'COMMON.LANGEVIN.lang0'
15089 ! include 'COMMON.CHAIN'
15090 ! include 'COMMON.DERIV'
15091 ! include 'COMMON.GEO'
15092 ! include 'COMMON.LOCAL'
15093 ! include 'COMMON.INTERACT'
15094 ! include 'COMMON.IOUNITS'
15095 ! include 'COMMON.NAMES'
15096 ! include 'COMMON.TIME1'
15097 real(kind=8) :: uzap1,uzap2
15098 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
15099 integer :: kstart,kend,lstart,lend,idummy
15100 real(kind=8) :: delta=1.0d-7
15101 !el local variables
15107 dUcartan(j,i)=0.0d0
15108 cdummy(j,i)=dc(j,i)
15109 dc(j,i)=dc(j,i)+delta
15110 call chainbuild_cart
15113 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15115 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
15119 kstart=ifrag(1,ipair(1,ii,iset),iset)
15120 kend=ifrag(2,ipair(1,ii,iset),iset)
15121 lstart=ifrag(1,ipair(2,ii,iset),iset)
15122 lend=ifrag(2,ipair(2,ii,iset),iset)
15123 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15124 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
15127 dc(j,i)=cdummy(j,i)
15128 call chainbuild_cart
15131 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15133 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
15137 kstart=ifrag(1,ipair(1,ii,iset),iset)
15138 kend=ifrag(2,ipair(1,ii,iset),iset)
15139 lstart=ifrag(1,ipair(2,ii,iset),iset)
15140 lend=ifrag(2,ipair(2,ii,iset),iset)
15141 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15142 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
15145 ducartan(j,i)=(uzap2-uzap1)/(delta)
15148 ! Calculating numerical gradients for dU/ddx
15150 duxcartan(j,i)=0.0d0
15152 cdummy(j,i)=dc(j,i+nres)
15153 dc(j,i+nres)=dc(j,i+nres)+delta
15154 call chainbuild_cart
15157 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15159 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
15163 kstart=ifrag(1,ipair(1,ii,iset),iset)
15164 kend=ifrag(2,ipair(1,ii,iset),iset)
15165 lstart=ifrag(1,ipair(2,ii,iset),iset)
15166 lend=ifrag(2,ipair(2,ii,iset),iset)
15167 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15168 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
15171 dc(j,i+nres)=cdummy(j,i)
15172 call chainbuild_cart
15175 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
15176 ifrag(2,ii,iset),.true.,idummy,idummy)
15177 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
15181 kstart=ifrag(1,ipair(1,ii,iset),iset)
15182 kend=ifrag(2,ipair(1,ii,iset),iset)
15183 lstart=ifrag(1,ipair(2,ii,iset),iset)
15184 lend=ifrag(2,ipair(2,ii,iset),iset)
15185 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15186 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
15189 duxcartan(j,i)=(uzap2-uzap1)/(delta)
15192 write(iout,*) "Numerical dUconst/ddc backbone "
15194 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
15196 ! write(iout,*) "Numerical dUconst/ddx side-chain "
15198 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
15201 end subroutine dEconstrQ_num
15202 !-----------------------------------------------------------------------------
15204 !-----------------------------------------------------------------------------
15205 subroutine check_energies
15207 ! use random, only: ran_number
15211 ! include 'DIMENSIONS'
15212 ! include 'COMMON.CHAIN'
15213 ! include 'COMMON.VAR'
15214 ! include 'COMMON.IOUNITS'
15215 ! include 'COMMON.SBRIDGE'
15216 ! include 'COMMON.LOCAL'
15217 ! include 'COMMON.GEO'
15219 ! External functions
15220 !EL double precision ran_number
15221 !EL external ran_number
15224 integer :: i,j,k,l,lmax,p,pmax
15225 real(kind=8) :: rmin,rmax
15226 real(kind=8) :: eij
15229 real(kind=8) :: wi,rij,tj,pj
15251 !t wi=ran_number(0.0D0,pi)
15252 ! wi=ran_number(0.0D0,pi/6.0D0)
15254 !t tj=ran_number(0.0D0,pi)
15255 !t pj=ran_number(0.0D0,pi)
15256 ! pj=ran_number(0.0D0,pi/6.0D0)
15260 !t rij=ran_number(rmin,rmax)
15262 c(1,j)=d*sin(pj)*cos(tj)
15263 c(2,j)=d*sin(pj)*sin(tj)
15269 c(3,i)=-rij-d*cos(wi)
15272 dc(k,nres+i)=c(k,nres+i)-c(k,i)
15273 dc_norm(k,nres+i)=dc(k,nres+i)/d
15274 dc(k,nres+j)=c(k,nres+j)-c(k,j)
15275 dc_norm(k,nres+j)=dc(k,nres+j)/d
15278 call dyn_ssbond_ene(i,j,eij)
15283 end subroutine check_energies
15284 !-----------------------------------------------------------------------------
15285 subroutine dyn_ssbond_ene(resi,resj,eij)
15290 ! include 'DIMENSIONS'
15291 ! include 'COMMON.SBRIDGE'
15292 ! include 'COMMON.CHAIN'
15293 ! include 'COMMON.DERIV'
15294 ! include 'COMMON.LOCAL'
15295 ! include 'COMMON.INTERACT'
15296 ! include 'COMMON.VAR'
15297 ! include 'COMMON.IOUNITS'
15298 ! include 'COMMON.CALC'
15302 ! include 'COMMON.MD'
15303 ! use MD, only: totT,t_bath
15306 ! External functions
15307 !EL double precision h_base
15308 !EL external h_base
15311 integer :: resi,resj
15314 real(kind=8) :: eij
15317 logical :: havebond
15318 integer itypi,itypj
15319 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
15320 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
15321 real(kind=8),dimension(3) :: dcosom1,dcosom2
15323 real(kind=8) :: pom1,pom2
15324 real(kind=8) :: ljA,ljB,ljXs
15325 real(kind=8),dimension(1:3) :: d_ljB
15326 real(kind=8) :: ssA,ssB,ssC,ssXs
15327 real(kind=8) :: ssxm,ljxm,ssm,ljm
15328 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
15329 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
15330 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
15331 !-------FIRST METHOD
15333 real(kind=8),dimension(1:3) :: d_xm
15334 !-------END FIRST METHOD
15335 !-------SECOND METHOD
15336 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
15337 !-------END SECOND METHOD
15339 !-------TESTING CODE
15340 !el logical :: checkstop,transgrad
15341 !el common /sschecks/ checkstop,transgrad
15343 integer :: icheck,nicheck,jcheck,njcheck
15344 real(kind=8),dimension(-1:1) :: echeck
15345 real(kind=8) :: deps,ssx0,ljx0
15346 !-------END TESTING CODE
15352 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
15353 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
15356 dxi=dc_norm(1,nres+i)
15357 dyi=dc_norm(2,nres+i)
15358 dzi=dc_norm(3,nres+i)
15359 dsci_inv=vbld_inv(i+nres)
15362 xj=c(1,nres+j)-c(1,nres+i)
15363 yj=c(2,nres+j)-c(2,nres+i)
15364 zj=c(3,nres+j)-c(3,nres+i)
15365 dxj=dc_norm(1,nres+j)
15366 dyj=dc_norm(2,nres+j)
15367 dzj=dc_norm(3,nres+j)
15368 dscj_inv=vbld_inv(j+nres)
15370 chi1=chi(itypi,itypj)
15371 chi2=chi(itypj,itypi)
15378 alf12=0.5D0*(alf1+alf2)
15380 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15381 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
15382 ! The following are set in sc_angular
15386 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
15387 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
15388 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
15390 rij=1.0D0/rij ! Reset this so it makes sense
15392 sig0ij=sigma(itypi,itypj)
15393 sig=sig0ij*dsqrt(1.0D0/sigsq)
15396 ljA=eps1*eps2rt**2*eps3rt**2
15397 ljB=ljA*bb(itypi,itypj)
15398 ljA=ljA*aa(itypi,itypj)
15399 ljxm=ljXs+(-2.0D0*aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
15404 deltat12=om2-om1+2.0d0
15405 cosphi=om12-om1*om2
15409 +akth*(deltat1*deltat1+deltat2*deltat2) &
15410 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
15411 ssxm=ssXs-0.5D0*ssB/ssA
15413 !-------TESTING CODE
15414 !$$$c Some extra output
15415 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
15416 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
15417 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
15418 !$$$ if (ssx0.gt.0.0d0) then
15419 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
15423 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
15424 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
15425 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
15427 !-------END TESTING CODE
15429 !-------TESTING CODE
15430 ! Stop and plot energy and derivative as a function of distance
15431 if (checkstop) then
15432 ssm=ssC-0.25D0*ssB*ssB/ssA
15433 ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
15434 if (ssm.lt.ljm .and. &
15435 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
15443 if (.not.checkstop) then
15448 do icheck=0,nicheck
15449 do jcheck=-1,njcheck
15450 if (checkstop) rij=(ssxm-1.0d0)+ &
15451 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
15452 !-------END TESTING CODE
15454 if (rij.gt.ljxm) then
15457 fac=(1.0D0/ljd)**expon
15458 e1=fac*fac*aa(itypi,itypj)
15459 e2=fac*bb(itypi,itypj)
15460 eij=eps1*eps2rt*eps3rt*(e1+e2)
15463 eij=eij*eps2rt*eps3rt
15466 e1=e1*eps1*eps2rt**2*eps3rt**2
15467 ed=-expon*(e1+eij)/ljd
15469 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
15470 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
15471 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
15472 -2.0D0*alf12*eps3der+sigder*sigsq_om12
15473 else if (rij.lt.ssxm) then
15476 eij=ssA*ssd*ssd+ssB*ssd+ssC
15478 ed=2*akcm*ssd+akct*deltat12
15480 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
15481 eom1=-2*akth*deltat1-pom1-om2*pom2
15482 eom2= 2*akth*deltat2+pom1-om1*pom2
15485 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
15487 d_ssxm(1)=0.5D0*akct/ssA
15488 d_ssxm(2)=-d_ssxm(1)
15491 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
15492 d_ljxm(2)=d_ljxm(1)*sigsq_om2
15493 d_ljxm(3)=d_ljxm(1)*sigsq_om12
15494 d_ljxm(1)=d_ljxm(1)*sigsq_om1
15496 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
15497 xm=0.5d0*(ssxm+ljxm)
15499 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
15501 if (rij.lt.xm) then
15503 ssm=ssC-0.25D0*ssB*ssB/ssA
15504 d_ssm(1)=0.5D0*akct*ssB/ssA
15505 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
15506 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
15508 f1=(rij-xm)/(ssxm-xm)
15509 f2=(rij-ssxm)/(xm-ssxm)
15513 delta_inv=1.0d0/(xm-ssxm)
15514 deltasq_inv=delta_inv*delta_inv
15516 fac1=deltasq_inv*fac*(xm-rij)
15517 fac2=deltasq_inv*fac*(rij-ssxm)
15518 ed=delta_inv*(Ht*hd2-ssm*hd1)
15519 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
15520 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
15521 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
15524 ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
15525 d_ljm(1)=-0.5D0*bb(itypi,itypj)/aa(itypi,itypj)*ljB
15526 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
15527 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
15529 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
15530 f1=(rij-ljxm)/(xm-ljxm)
15531 f2=(rij-xm)/(ljxm-xm)
15535 delta_inv=1.0d0/(ljxm-xm)
15536 deltasq_inv=delta_inv*delta_inv
15538 fac1=deltasq_inv*fac*(ljxm-rij)
15539 fac2=deltasq_inv*fac*(rij-xm)
15540 ed=delta_inv*(ljm*hd2-Ht*hd1)
15541 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
15542 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
15543 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
15545 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
15547 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
15553 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
15554 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
15555 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
15557 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
15558 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
15559 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
15560 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
15561 !$$$ d_ssm(3)=omega
15563 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
15565 !$$$ d_ljm(k)=ljm*d_ljB(k)
15569 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
15570 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
15571 !$$$ d_ss(2)=akct*ssd
15572 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
15573 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
15576 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
15577 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
15578 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
15580 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
15581 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
15583 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
15585 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
15586 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
15587 !$$$ h1=h_base(f1,hd1)
15588 !$$$ h2=h_base(f2,hd2)
15589 !$$$ eij=ss*h1+ljf*h2
15590 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
15591 !$$$ deltasq_inv=delta_inv*delta_inv
15592 !$$$ fac=ljf*hd2-ss*hd1
15593 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
15594 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
15595 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
15596 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
15597 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
15598 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
15599 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
15601 !$$$ havebond=.false.
15602 !$$$ if (ed.gt.0.0d0) havebond=.true.
15603 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
15610 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
15611 ! write(iout,'(a15,f12.2,f8.1,2i5)')
15612 ! & "SSBOND_E_FORM",totT,t_bath,i,j
15616 dyn_ssbond_ij(i,j)=eij
15617 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
15618 dyn_ssbond_ij(i,j)=1.0d300
15621 ! write(iout,'(a15,f12.2,f8.1,2i5)')
15622 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
15627 !-------TESTING CODE
15628 !el if (checkstop) then
15629 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
15630 "CHECKSTOP",rij,eij,ed
15634 if (checkstop) then
15635 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
15638 if (checkstop) then
15642 !-------END TESTING CODE
15645 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
15646 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
15649 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
15652 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
15653 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
15654 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
15655 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
15656 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
15657 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
15661 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
15666 gvdwc(l,i)=gvdwc(l,i)-gg(l)
15667 gvdwc(l,j)=gvdwc(l,j)+gg(l)
15671 end subroutine dyn_ssbond_ene
15672 !-----------------------------------------------------------------------------
15673 real(kind=8) function h_base(x,deriv)
15674 ! A smooth function going 0->1 in range [0,1]
15675 ! It should NOT be called outside range [0,1], it will not work there.
15682 real(kind=8) :: deriv
15685 real(kind=8) :: xsq
15688 ! Two parabolas put together. First derivative zero at extrema
15689 !$$$ if (x.lt.0.5D0) then
15690 !$$$ h_base=2.0D0*x*x
15694 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
15695 !$$$ deriv=4.0D0*deriv
15698 ! Third degree polynomial. First derivative zero at extrema
15699 h_base=x*x*(3.0d0-2.0d0*x)
15700 deriv=6.0d0*x*(1.0d0-x)
15702 ! Fifth degree polynomial. First and second derivatives zero at extrema
15704 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
15706 !$$$ deriv=deriv*deriv
15707 !$$$ deriv=30.0d0*xsq*deriv
15710 end function h_base
15711 !-----------------------------------------------------------------------------
15712 subroutine dyn_set_nss
15713 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
15715 use MD_data, only: totT,t_bath
15717 ! include 'DIMENSIONS'
15721 ! include 'COMMON.SBRIDGE'
15722 ! include 'COMMON.CHAIN'
15723 ! include 'COMMON.IOUNITS'
15724 ! include 'COMMON.SETUP'
15725 ! include 'COMMON.MD'
15727 real(kind=8) :: emin
15728 integer :: i,j,imin,ierr
15729 integer :: diff,allnss,newnss
15730 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
15733 integer,dimension(0:nfgtasks) :: i_newnss
15734 integer,dimension(0:nfgtasks) :: displ
15735 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
15736 integer :: g_newnss
15741 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
15750 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
15754 if (allflag(i).eq.0 .and. &
15755 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
15756 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
15760 if (emin.lt.1.0d300) then
15763 if (allflag(i).eq.0 .and. &
15764 (allihpb(i).eq.allihpb(imin) .or. &
15765 alljhpb(i).eq.allihpb(imin) .or. &
15766 allihpb(i).eq.alljhpb(imin) .or. &
15767 alljhpb(i).eq.alljhpb(imin))) then
15774 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
15778 if (allflag(i).eq.1) then
15780 newihpb(newnss)=allihpb(i)
15781 newjhpb(newnss)=alljhpb(i)
15786 if (nfgtasks.gt.1)then
15788 call MPI_Reduce(newnss,g_newnss,1,&
15789 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
15790 call MPI_Gather(newnss,1,MPI_INTEGER,&
15791 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
15793 do i=1,nfgtasks-1,1
15794 displ(i)=i_newnss(i-1)+displ(i-1)
15796 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
15797 g_newihpb,i_newnss,displ,MPI_INTEGER,&
15799 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
15800 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
15802 if(fg_rank.eq.0) then
15803 ! print *,'g_newnss',g_newnss
15804 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
15805 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
15808 newihpb(i)=g_newihpb(i)
15809 newjhpb(i)=g_newjhpb(i)
15817 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
15822 if (idssb(i).eq.newihpb(j) .and. &
15823 jdssb(i).eq.newjhpb(j)) found=.true.
15827 if (.not.found.and.fg_rank.eq.0) &
15828 write(iout,'(a15,f12.2,f8.1,2i5)') &
15829 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
15837 if (newihpb(i).eq.idssb(j) .and. &
15838 newjhpb(i).eq.jdssb(j)) found=.true.
15842 if (.not.found.and.fg_rank.eq.0) &
15843 write(iout,'(a15,f12.2,f8.1,2i5)') &
15844 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
15851 idssb(i)=newihpb(i)
15852 jdssb(i)=newjhpb(i)
15856 end subroutine dyn_set_nss
15857 !-----------------------------------------------------------------------------
15859 subroutine read_ssHist
15862 ! include 'DIMENSIONS'
15863 ! include "DIMENSIONS.FREE"
15864 ! include 'COMMON.FREE'
15867 character(len=80) :: controlcard
15870 call card_concat(controlcard,.true.)
15871 read(controlcard,*) &
15872 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
15876 end subroutine read_ssHist
15878 !-----------------------------------------------------------------------------
15879 integer function indmat(i,j)
15881 ! get the position of the jth ijth fragment of the chain coordinate system
15882 ! in the fromto array.
15885 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
15887 end function indmat
15888 !-----------------------------------------------------------------------------
15889 real(kind=8) function sigm(x)
15895 !-----------------------------------------------------------------------------
15896 !-----------------------------------------------------------------------------
15897 subroutine alloc_ener_arrays
15898 !EL Allocation of arrays used by module energy
15900 !el local variables
15903 if(nres.lt.100) then
15905 elseif(nres.lt.200) then
15906 maxconts=0.8*nres ! Max. number of contacts per residue
15908 maxconts=0.6*nres ! (maxconts=maxres/4)
15910 maxcont=12*nres ! Max. number of SC contacts
15911 maxvar=6*nres ! Max. number of variables
15912 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
15913 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
15914 !----------------------
15915 ! arrays in subroutine init_int_table
15917 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
15918 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
15920 allocate(nint_gr(nres))
15921 allocate(nscp_gr(nres))
15922 allocate(ielstart(nres))
15923 allocate(ielend(nres))
15925 allocate(istart(nres,maxint_gr))
15926 allocate(iend(nres,maxint_gr))
15927 !(maxres,maxint_gr)
15928 allocate(iscpstart(nres,maxint_gr))
15929 allocate(iscpend(nres,maxint_gr))
15930 !(maxres,maxint_gr)
15931 allocate(ielstart_vdw(nres))
15932 allocate(ielend_vdw(nres))
15935 allocate(lentyp(0:nfgtasks-1))
15937 !----------------------
15939 ! common /contacts/
15940 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
15941 allocate(icont(2,maxcont))
15943 ! common /contacts1/
15944 allocate(num_cont(0:nres+4))
15946 allocate(jcont(maxconts,nres))
15948 allocate(facont(maxconts,nres))
15950 allocate(gacont(3,maxconts,nres))
15951 !(3,maxconts,maxres)
15952 ! common /contacts_hb/
15953 allocate(gacontp_hb1(3,maxconts,nres))
15954 allocate(gacontp_hb2(3,maxconts,nres))
15955 allocate(gacontp_hb3(3,maxconts,nres))
15956 allocate(gacontm_hb1(3,maxconts,nres))
15957 allocate(gacontm_hb2(3,maxconts,nres))
15958 allocate(gacontm_hb3(3,maxconts,nres))
15959 allocate(gacont_hbr(3,maxconts,nres))
15960 allocate(grij_hb_cont(3,maxconts,nres))
15961 !(3,maxconts,maxres)
15962 allocate(facont_hb(maxconts,nres))
15963 allocate(ees0p(maxconts,nres))
15964 allocate(ees0m(maxconts,nres))
15965 allocate(d_cont(maxconts,nres))
15967 allocate(num_cont_hb(nres))
15969 allocate(jcont_hb(maxconts,nres))
15972 allocate(Ug(2,2,nres))
15973 allocate(Ugder(2,2,nres))
15974 allocate(Ug2(2,2,nres))
15975 allocate(Ug2der(2,2,nres))
15977 allocate(obrot(2,nres))
15978 allocate(obrot2(2,nres))
15979 allocate(obrot_der(2,nres))
15980 allocate(obrot2_der(2,nres))
15982 ! common /precomp1/
15983 allocate(mu(2,nres))
15984 allocate(muder(2,nres))
15985 allocate(Ub2(2,nres))
15988 allocate(Ub2der(2,nres))
15989 allocate(Ctobr(2,nres))
15990 allocate(Ctobrder(2,nres))
15991 allocate(Dtobr2(2,nres))
15992 allocate(Dtobr2der(2,nres))
15994 allocate(EUg(2,2,nres))
15995 allocate(EUgder(2,2,nres))
15996 allocate(CUg(2,2,nres))
15997 allocate(CUgder(2,2,nres))
15998 allocate(DUg(2,2,nres))
15999 allocate(Dugder(2,2,nres))
16000 allocate(DtUg2(2,2,nres))
16001 allocate(DtUg2der(2,2,nres))
16003 ! common /precomp2/
16004 allocate(Ug2Db1t(2,nres))
16005 allocate(Ug2Db1tder(2,nres))
16006 allocate(CUgb2(2,nres))
16007 allocate(CUgb2der(2,nres))
16009 allocate(EUgC(2,2,nres))
16010 allocate(EUgCder(2,2,nres))
16011 allocate(EUgD(2,2,nres))
16012 allocate(EUgDder(2,2,nres))
16013 allocate(DtUg2EUg(2,2,nres))
16014 allocate(Ug2DtEUg(2,2,nres))
16016 allocate(Ug2DtEUgder(2,2,2,nres))
16017 allocate(DtUg2EUgder(2,2,2,nres))
16019 ! common /rotat_old/
16020 allocate(costab(nres))
16021 allocate(sintab(nres))
16022 allocate(costab2(nres))
16023 allocate(sintab2(nres))
16026 allocate(a_chuj(2,2,maxconts,nres))
16027 !(2,2,maxconts,maxres)(maxconts=maxres/4)
16028 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
16029 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
16030 ! common /contdistrib/
16031 allocate(ncont_sent(nres))
16032 allocate(ncont_recv(nres))
16034 allocate(iat_sent(nres))
16036 allocate(iint_sent(4,nres,nres))
16037 allocate(iint_sent_local(4,nres,nres))
16039 allocate(iturn3_sent(4,0:nres+4))
16040 allocate(iturn4_sent(4,0:nres+4))
16041 allocate(iturn3_sent_local(4,nres))
16042 allocate(iturn4_sent_local(4,nres))
16044 allocate(itask_cont_from(0:nfgtasks-1))
16045 allocate(itask_cont_to(0:nfgtasks-1))
16046 !(0:max_fg_procs-1)
16050 !----------------------
16053 allocate(dcdv(6,maxdim))
16054 allocate(dxdv(6,maxdim))
16056 allocate(dxds(6,nres))
16058 allocate(gradx(3,nres,0:2))
16059 allocate(gradc(3,nres,0:2))
16061 allocate(gvdwx(3,nres))
16062 allocate(gvdwc(3,nres))
16063 allocate(gelc(3,nres))
16064 allocate(gelc_long(3,nres))
16065 allocate(gvdwpp(3,nres))
16066 allocate(gvdwc_scpp(3,nres))
16067 allocate(gradx_scp(3,nres))
16068 allocate(gvdwc_scp(3,nres))
16069 allocate(ghpbx(3,nres))
16070 allocate(ghpbc(3,nres))
16071 allocate(gradcorr(3,nres))
16072 allocate(gradcorr_long(3,nres))
16073 allocate(gradcorr5_long(3,nres))
16074 allocate(gradcorr6_long(3,nres))
16075 allocate(gcorr6_turn_long(3,nres))
16076 allocate(gradxorr(3,nres))
16077 allocate(gradcorr5(3,nres))
16078 allocate(gradcorr6(3,nres))
16080 allocate(gloc(0:maxvar,0:2))
16081 allocate(gloc_x(0:maxvar,2))
16083 allocate(gel_loc(3,nres))
16084 allocate(gel_loc_long(3,nres))
16085 allocate(gcorr3_turn(3,nres))
16086 allocate(gcorr4_turn(3,nres))
16087 allocate(gcorr6_turn(3,nres))
16088 allocate(gradb(3,nres))
16089 allocate(gradbx(3,nres))
16091 allocate(gel_loc_loc(maxvar))
16092 allocate(gel_loc_turn3(maxvar))
16093 allocate(gel_loc_turn4(maxvar))
16094 allocate(gel_loc_turn6(maxvar))
16095 allocate(gcorr_loc(maxvar))
16096 allocate(g_corr5_loc(maxvar))
16097 allocate(g_corr6_loc(maxvar))
16099 allocate(gsccorc(3,nres))
16100 allocate(gsccorx(3,nres))
16102 allocate(gsccor_loc(nres))
16104 allocate(dtheta(3,2,nres))
16106 allocate(gscloc(3,nres))
16107 allocate(gsclocx(3,nres))
16109 allocate(dphi(3,3,nres))
16110 allocate(dalpha(3,3,nres))
16111 allocate(domega(3,3,nres))
16113 ! common /deriv_scloc/
16114 allocate(dXX_C1tab(3,nres))
16115 allocate(dYY_C1tab(3,nres))
16116 allocate(dZZ_C1tab(3,nres))
16117 allocate(dXX_Ctab(3,nres))
16118 allocate(dYY_Ctab(3,nres))
16119 allocate(dZZ_Ctab(3,nres))
16120 allocate(dXX_XYZtab(3,nres))
16121 allocate(dYY_XYZtab(3,nres))
16122 allocate(dZZ_XYZtab(3,nres))
16125 allocate(jgrad_start(nres))
16126 allocate(jgrad_end(nres))
16128 !----------------------
16131 allocate(ibond_displ(0:nfgtasks-1))
16132 allocate(ibond_count(0:nfgtasks-1))
16133 allocate(ithet_displ(0:nfgtasks-1))
16134 allocate(ithet_count(0:nfgtasks-1))
16135 allocate(iphi_displ(0:nfgtasks-1))
16136 allocate(iphi_count(0:nfgtasks-1))
16137 allocate(iphi1_displ(0:nfgtasks-1))
16138 allocate(iphi1_count(0:nfgtasks-1))
16139 allocate(ivec_displ(0:nfgtasks-1))
16140 allocate(ivec_count(0:nfgtasks-1))
16141 allocate(iset_displ(0:nfgtasks-1))
16142 allocate(iset_count(0:nfgtasks-1))
16143 allocate(iint_count(0:nfgtasks-1))
16144 allocate(iint_displ(0:nfgtasks-1))
16145 !(0:max_fg_procs-1)
16146 !----------------------
16149 allocate(gcart(3,0:nres))
16150 allocate(gxcart(3,0:nres))
16152 allocate(gradcag(3,nres))
16153 allocate(gradxag(3,nres))
16155 ! common /back_constr/
16156 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
16157 allocate(dutheta(nres))
16158 allocate(dugamma(nres))
16160 allocate(duscdiff(3,nres))
16161 allocate(duscdiffx(3,nres))
16163 !el i io:read_fragments
16164 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
16165 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
16167 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
16168 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
16169 allocate(mset(0:nprocs)) !(maxprocs/20)
16171 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
16172 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
16173 allocate(dUdconst(3,0:nres))
16174 allocate(dUdxconst(3,0:nres))
16175 allocate(dqwol(3,0:nres))
16176 allocate(dxqwol(3,0:nres))
16178 !----------------------
16180 ! common /sbridge/ in io_common: read_bridge
16181 !el allocate((:),allocatable :: iss !(maxss)
16182 ! common /links/ in io_common: read_bridge
16183 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
16184 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
16185 ! common /dyn_ssbond/
16186 ! and side-chain vectors in theta or phi.
16187 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
16191 dyn_ssbond_ij(:,:)=1.0d300
16196 allocate(idssb(nss),jdssb(nss))
16199 allocate(dyn_ss_mask(nres))
16201 dyn_ss_mask(:)=.false.
16202 !----------------------
16204 ! Parameters of the SCCOR term
16206 !el in io_conf: parmread
16207 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
16208 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
16209 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
16210 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
16211 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
16212 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
16213 ! allocate(vlor1sccor(maxterm_sccor,20,20))
16214 ! allocate(vlor2sccor(maxterm_sccor,20,20))
16215 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
16217 allocate(gloc_sc(3,0:2*nres,0:10))
16218 !(3,0:maxres2,10)maxres2=2*maxres
16219 allocate(dcostau(3,3,3,2*nres))
16220 allocate(dsintau(3,3,3,2*nres))
16221 allocate(dtauangle(3,3,3,2*nres))
16222 allocate(dcosomicron(3,3,3,2*nres))
16223 allocate(domicron(3,3,3,2*nres))
16224 !(3,3,3,maxres2)maxres2=2*maxres
16225 !----------------------
16228 allocate(varall(maxvar))
16229 !(maxvar)(maxvar=6*maxres)
16230 allocate(mask_theta(nres))
16231 allocate(mask_phi(nres))
16232 allocate(mask_side(nres))
16234 !----------------------
16237 allocate(uy(3,nres))
16238 allocate(uz(3,nres))
16240 allocate(uygrad(3,3,2,nres))
16241 allocate(uzgrad(3,3,2,nres))
16245 end subroutine alloc_ener_arrays
16246 !-----------------------------------------------------------------------------
16247 !-----------------------------------------------------------------------------