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).eq.ntyp1) cycle
5542 if (iabs(itype(i)).eq.20) then
5547 itori=itortyp(itype(i-2))
5548 itori1=itortyp(itype(i-1))
5551 ! Regular cosine and sine terms
5552 do j=1,nterm(itori,itori1,iblock)
5553 v1ij=v1(j,itori,itori1,iblock)
5554 v2ij=v2(j,itori,itori1,iblock)
5557 etors=etors+v1ij*cosphi+v2ij*sinphi
5558 if (energy_dec) etors_ii=etors_ii+ &
5559 v1ij*cosphi+v2ij*sinphi
5560 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5564 ! E = SUM ----------------------------------- - v1
5565 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5567 cosphi=dcos(0.5d0*phii)
5568 sinphi=dsin(0.5d0*phii)
5569 do j=1,nlor(itori,itori1,iblock)
5570 vl1ij=vlor1(j,itori,itori1)
5571 vl2ij=vlor2(j,itori,itori1)
5572 vl3ij=vlor3(j,itori,itori1)
5573 pom=vl2ij*cosphi+vl3ij*sinphi
5574 pom1=1.0d0/(pom*pom+1.0d0)
5575 etors=etors+vl1ij*pom1
5576 if (energy_dec) etors_ii=etors_ii+ &
5579 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5581 ! Subtract the constant term
5582 etors=etors-v0(itori,itori1,iblock)
5583 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5584 'etor',i,etors_ii-v0(itori,itori1,iblock)
5586 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5587 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
5588 (v1(j,itori,itori1,iblock),j=1,6),&
5589 (v2(j,itori,itori1,iblock),j=1,6)
5590 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5591 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5593 ! 6/20/98 - dihedral angle constraints
5595 ! do i=1,ndih_constr
5596 do i=idihconstr_start,idihconstr_end
5597 itori=idih_constr(i)
5599 difi=pinorm(phii-phi0(i))
5600 if (difi.gt.drange(i)) then
5602 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5603 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5604 else if (difi.lt.-drange(i)) then
5606 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5607 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5611 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5612 !d & rad2deg*phi0(i), rad2deg*drange(i),
5613 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5615 !d write (iout,*) 'edihcnstr',edihcnstr
5618 !-----------------------------------------------------------------------------
5619 subroutine etor_d(etors_d)
5620 ! 6/23/01 Compute double torsional energy
5621 ! implicit real*8 (a-h,o-z)
5622 ! include 'DIMENSIONS'
5623 ! include 'COMMON.VAR'
5624 ! include 'COMMON.GEO'
5625 ! include 'COMMON.LOCAL'
5626 ! include 'COMMON.TORSION'
5627 ! include 'COMMON.INTERACT'
5628 ! include 'COMMON.DERIV'
5629 ! include 'COMMON.CHAIN'
5630 ! include 'COMMON.NAMES'
5631 ! include 'COMMON.IOUNITS'
5632 ! include 'COMMON.FFIELD'
5633 ! include 'COMMON.TORCNSTR'
5634 real(kind=8) :: etors_d,etors_d_ii
5637 integer :: i,j,k,l,itori,itori1,itori2,iblock
5638 real(kind=8) :: phii,phii1,gloci1,gloci2,&
5639 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
5640 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
5641 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
5642 ! Set lprn=.true. for debugging
5646 ! write(iout,*) "a tu??"
5647 do i=iphid_start,iphid_end
5649 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
5650 .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5651 itori=itortyp(itype(i-2))
5652 itori1=itortyp(itype(i-1))
5653 itori2=itortyp(itype(i))
5659 if (iabs(itype(i+1)).eq.20) iblock=2
5661 ! Regular cosine and sine terms
5662 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5663 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5664 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5665 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5666 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5667 cosphi1=dcos(j*phii)
5668 sinphi1=dsin(j*phii)
5669 cosphi2=dcos(j*phii1)
5670 sinphi2=dsin(j*phii1)
5671 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
5672 v2cij*cosphi2+v2sij*sinphi2
5673 if (energy_dec) etors_d_ii=etors_d_ii+ &
5674 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
5675 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5676 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5678 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5680 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5681 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5682 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5683 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5684 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5685 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5686 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5687 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5688 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
5689 v1sdij*sinphi1p2+v2sdij*sinphi1m2
5690 if (energy_dec) etors_d_ii=etors_d_ii+ &
5691 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
5692 v1sdij*sinphi1p2+v2sdij*sinphi1m2
5693 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
5694 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5695 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
5696 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5699 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5700 'etor_d',i,etors_d_ii
5701 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5702 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5705 end subroutine etor_d
5707 !-----------------------------------------------------------------------------
5708 subroutine eback_sc_corr(esccor)
5709 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
5710 ! conformational states; temporarily implemented as differences
5711 ! between UNRES torsional potentials (dependent on three types of
5712 ! residues) and the torsional potentials dependent on all 20 types
5713 ! of residues computed from AM1 energy surfaces of terminally-blocked
5714 ! amino-acid residues.
5715 ! implicit real*8 (a-h,o-z)
5716 ! include 'DIMENSIONS'
5717 ! include 'COMMON.VAR'
5718 ! include 'COMMON.GEO'
5719 ! include 'COMMON.LOCAL'
5720 ! include 'COMMON.TORSION'
5721 ! include 'COMMON.SCCOR'
5722 ! include 'COMMON.INTERACT'
5723 ! include 'COMMON.DERIV'
5724 ! include 'COMMON.CHAIN'
5725 ! include 'COMMON.NAMES'
5726 ! include 'COMMON.IOUNITS'
5727 ! include 'COMMON.FFIELD'
5728 ! include 'COMMON.CONTROL'
5729 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
5732 integer :: i,interty,j,isccori,isccori1,intertyp
5733 ! Set lprn=.true. for debugging
5736 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5738 do i=itau_start,itau_end
5739 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5741 isccori=isccortyp(itype(i-2))
5742 isccori1=isccortyp(itype(i-1))
5744 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5746 do intertyp=1,3 !intertyp
5748 !c Added 09 May 2012 (Adasko)
5749 !c Intertyp means interaction type of backbone mainchain correlation:
5750 ! 1 = SC...Ca...Ca...Ca
5751 ! 2 = Ca...Ca...Ca...SC
5752 ! 3 = SC...Ca...Ca...SCi
5754 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. &
5755 (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or. &
5756 (itype(i-1).eq.ntyp1))) &
5757 .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) &
5758 .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1) &
5759 .or.(itype(i).eq.ntyp1))) &
5760 .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. &
5761 (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. &
5762 (itype(i-3).eq.ntyp1)))) cycle
5763 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5764 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1)) &
5766 do j=1,nterm_sccor(isccori,isccori1)
5767 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5768 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5769 cosphi=dcos(j*tauangle(intertyp,i))
5770 sinphi=dsin(j*tauangle(intertyp,i))
5771 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
5772 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5773 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5775 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
5776 'esccor',i,intertyp,esccor_ii
5777 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5778 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5780 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5781 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,&
5782 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
5783 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5784 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5789 end subroutine eback_sc_corr
5790 !-----------------------------------------------------------------------------
5791 subroutine multibody(ecorr)
5792 ! This subroutine calculates multi-body contributions to energy following
5793 ! the idea of Skolnick et al. If side chains I and J make a contact and
5794 ! at the same time side chains I+1 and J+1 make a contact, an extra
5795 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5796 ! implicit real*8 (a-h,o-z)
5797 ! include 'DIMENSIONS'
5798 ! include 'COMMON.IOUNITS'
5799 ! include 'COMMON.DERIV'
5800 ! include 'COMMON.INTERACT'
5801 ! include 'COMMON.CONTACTS'
5802 real(kind=8),dimension(3) :: gx,gx1
5804 real(kind=8) :: ecorr
5805 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
5806 ! Set lprn=.true. for debugging
5810 write (iout,'(a)') 'Contact function values:'
5812 write (iout,'(i2,20(1x,i2,f10.5))') &
5813 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5818 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
5819 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
5831 num_conti=num_cont(i)
5832 num_conti1=num_cont(i1)
5837 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5838 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5839 !d & ' ishift=',ishift
5840 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5841 ! The system gains extra energy.
5842 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5843 endif ! j1==j+-ishift
5851 end subroutine multibody
5852 !-----------------------------------------------------------------------------
5853 real(kind=8) function esccorr(i,j,k,l,jj,kk)
5854 ! implicit real*8 (a-h,o-z)
5855 ! include 'DIMENSIONS'
5856 ! include 'COMMON.IOUNITS'
5857 ! include 'COMMON.DERIV'
5858 ! include 'COMMON.INTERACT'
5859 ! include 'COMMON.CONTACTS'
5860 real(kind=8),dimension(3) :: gx,gx1
5862 integer :: i,j,k,l,jj,kk,m,ll
5863 real(kind=8) :: eij,ekl
5867 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5868 ! Calculate the multi-body contribution to energy.
5869 ! Calculate multi-body contributions to the gradient.
5870 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5871 !d & k,l,(gacont(m,kk,k),m=1,3)
5873 gx(m) =ekl*gacont(m,jj,i)
5874 gx1(m)=eij*gacont(m,kk,k)
5875 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5876 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5877 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5878 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5882 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5887 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5892 end function esccorr
5893 !-----------------------------------------------------------------------------
5894 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5895 ! This subroutine calculates multi-body contributions to hydrogen-bonding
5896 ! implicit real*8 (a-h,o-z)
5897 ! include 'DIMENSIONS'
5898 ! include 'COMMON.IOUNITS'
5901 ! integer :: maxconts !max_cont=maxconts =nres/4
5902 integer,parameter :: max_dim=26
5903 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5904 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
5905 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
5906 !el common /przechowalnia/ zapas
5907 integer :: status(MPI_STATUS_SIZE)
5908 integer,dimension((nres/4)*2) :: req !maxconts*2
5909 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
5911 ! include 'COMMON.SETUP'
5912 ! include 'COMMON.FFIELD'
5913 ! include 'COMMON.DERIV'
5914 ! include 'COMMON.INTERACT'
5915 ! include 'COMMON.CONTACTS'
5916 ! include 'COMMON.CONTROL'
5917 ! include 'COMMON.LOCAL'
5918 real(kind=8),dimension(3) :: gx,gx1
5919 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
5920 logical :: lprn,ldone
5922 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
5923 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
5925 ! Set lprn=.true. for debugging
5929 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
5932 if (nfgtasks.le.1) goto 30
5934 write (iout,'(a)') 'Contact function values before RECEIVE:'
5936 write (iout,'(2i3,50(1x,i2,f5.2))') &
5937 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
5942 do i=1,ntask_cont_from
5945 do i=1,ntask_cont_to
5948 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5950 ! Make the list of contacts to send to send to other procesors
5951 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5953 do i=iturn3_start,iturn3_end
5954 ! write (iout,*) "make contact list turn3",i," num_cont",
5956 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5958 do i=iturn4_start,iturn4_end
5959 ! write (iout,*) "make contact list turn4",i," num_cont",
5961 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5965 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
5967 do j=1,num_cont_hb(i)
5970 iproc=iint_sent_local(k,jjc,ii)
5971 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5972 if (iproc.gt.0) then
5973 ncont_sent(iproc)=ncont_sent(iproc)+1
5974 nn=ncont_sent(iproc)
5976 zapas(2,nn,iproc)=jjc
5977 zapas(3,nn,iproc)=facont_hb(j,i)
5978 zapas(4,nn,iproc)=ees0p(j,i)
5979 zapas(5,nn,iproc)=ees0m(j,i)
5980 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5981 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5982 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5983 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5984 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5985 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5986 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5987 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5988 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5989 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5990 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
5991 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
5992 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
5993 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
5994 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
5995 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
5996 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
5997 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
5998 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
5999 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6000 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6007 "Numbers of contacts to be sent to other processors",&
6008 (ncont_sent(i),i=1,ntask_cont_to)
6009 write (iout,*) "Contacts sent"
6010 do ii=1,ntask_cont_to
6012 iproc=itask_cont_to(ii)
6013 write (iout,*) nn," contacts to processor",iproc,&
6014 " of CONT_TO_COMM group"
6016 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6024 CorrelID1=nfgtasks+fg_rank+1
6026 ! Receive the numbers of needed contacts from other processors
6027 do ii=1,ntask_cont_from
6028 iproc=itask_cont_from(ii)
6030 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
6031 FG_COMM,req(ireq),IERR)
6033 ! write (iout,*) "IRECV ended"
6035 ! Send the number of contacts needed by other processors
6036 do ii=1,ntask_cont_to
6037 iproc=itask_cont_to(ii)
6039 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
6040 FG_COMM,req(ireq),IERR)
6042 ! write (iout,*) "ISEND ended"
6043 ! write (iout,*) "number of requests (nn)",ireq
6046 call MPI_Waitall(ireq,req,status_array,ierr)
6048 ! & "Numbers of contacts to be received from other processors",
6049 ! & (ncont_recv(i),i=1,ntask_cont_from)
6053 do ii=1,ntask_cont_from
6054 iproc=itask_cont_from(ii)
6056 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
6057 ! & " of CONT_TO_COMM group"
6061 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
6062 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6063 ! write (iout,*) "ireq,req",ireq,req(ireq)
6066 ! Send the contacts to processors that need them
6067 do ii=1,ntask_cont_to
6068 iproc=itask_cont_to(ii)
6070 ! write (iout,*) nn," contacts to processor",iproc,
6071 ! & " of CONT_TO_COMM group"
6074 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
6075 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6076 ! write (iout,*) "ireq,req",ireq,req(ireq)
6078 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6082 ! write (iout,*) "number of requests (contacts)",ireq
6083 ! write (iout,*) "req",(req(i),i=1,4)
6086 call MPI_Waitall(ireq,req,status_array,ierr)
6087 do iii=1,ntask_cont_from
6088 iproc=itask_cont_from(iii)
6091 write (iout,*) "Received",nn," contacts from processor",iproc,&
6092 " of CONT_FROM_COMM group"
6095 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6100 ii=zapas_recv(1,i,iii)
6101 ! Flag the received contacts to prevent double-counting
6102 jj=-zapas_recv(2,i,iii)
6103 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6105 nnn=num_cont_hb(ii)+1
6108 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6109 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6110 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6111 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6112 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6113 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6114 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6115 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6116 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6117 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6118 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6119 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6120 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6121 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6122 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6123 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6124 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6125 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6126 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6127 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6128 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6129 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6130 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6131 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6136 write (iout,'(a)') 'Contact function values after receive:'
6138 write (iout,'(2i3,50(1x,i3,f5.2))') &
6139 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6147 write (iout,'(a)') 'Contact function values:'
6149 write (iout,'(2i3,50(1x,i3,f5.2))') &
6150 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6156 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6157 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6158 ! Remove the loop below after debugging !!!
6165 ! Calculate the local-electrostatic correlation terms
6166 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6168 num_conti=num_cont_hb(i)
6169 num_conti1=num_cont_hb(i+1)
6176 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
6177 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
6178 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
6179 .or. j.lt.0 .and. j1.gt.0) .and. &
6180 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6181 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6182 ! The system gains extra energy.
6183 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6184 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
6185 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6187 else if (j1.eq.j) then
6188 ! Contacts I-J and I-(J+1) occur simultaneously.
6189 ! The system loses extra energy.
6190 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6195 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6196 ! & ' jj=',jj,' kk=',kk
6198 ! Contacts I-J and (I+1)-J occur simultaneously.
6199 ! The system loses extra energy.
6200 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6206 end subroutine multibody_hb
6207 !-----------------------------------------------------------------------------
6208 subroutine add_hb_contact(ii,jj,itask)
6209 ! implicit real*8 (a-h,o-z)
6210 ! include "DIMENSIONS"
6211 ! include "COMMON.IOUNITS"
6212 ! include "COMMON.CONTACTS"
6213 ! integer,parameter :: maxconts=nres/4
6214 integer,parameter :: max_dim=26
6215 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6216 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
6217 ! common /przechowalnia/ zapas
6218 integer :: i,j,ii,jj,iproc,nn,jjc
6219 integer,dimension(4) :: itask
6220 ! write (iout,*) "itask",itask
6223 if (iproc.gt.0) then
6224 do j=1,num_cont_hb(ii)
6226 ! write (iout,*) "i",ii," j",jj," jjc",jjc
6228 ncont_sent(iproc)=ncont_sent(iproc)+1
6229 nn=ncont_sent(iproc)
6230 zapas(1,nn,iproc)=ii
6231 zapas(2,nn,iproc)=jjc
6232 zapas(3,nn,iproc)=facont_hb(j,ii)
6233 zapas(4,nn,iproc)=ees0p(j,ii)
6234 zapas(5,nn,iproc)=ees0m(j,ii)
6235 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6236 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6237 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6238 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6239 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6240 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6241 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6242 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6243 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6244 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6245 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6246 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6247 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6248 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6249 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6250 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6251 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6252 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6253 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6254 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6255 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6262 end subroutine add_hb_contact
6263 !-----------------------------------------------------------------------------
6264 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
6265 ! This subroutine calculates multi-body contributions to hydrogen-bonding
6266 ! implicit real*8 (a-h,o-z)
6267 ! include 'DIMENSIONS'
6268 ! include 'COMMON.IOUNITS'
6269 integer,parameter :: max_dim=70
6272 ! integer :: maxconts !max_cont=maxconts=nres/4
6273 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6274 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
6275 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6276 ! common /przechowalnia/ zapas
6277 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
6278 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
6281 ! include 'COMMON.SETUP'
6282 ! include 'COMMON.FFIELD'
6283 ! include 'COMMON.DERIV'
6284 ! include 'COMMON.LOCAL'
6285 ! include 'COMMON.INTERACT'
6286 ! include 'COMMON.CONTACTS'
6287 ! include 'COMMON.CHAIN'
6288 ! include 'COMMON.CONTROL'
6289 real(kind=8),dimension(3) :: gx,gx1
6290 integer,dimension(nres) :: num_cont_hb_old
6291 logical :: lprn,ldone
6292 !EL double precision eello4,eello5,eelo6,eello_turn6
6293 !EL external eello4,eello5,eello6,eello_turn6
6295 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
6296 j1,jp1,i1,num_conti1
6297 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
6298 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
6300 ! Set lprn=.true. for debugging
6305 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
6307 num_cont_hb_old(i)=num_cont_hb(i)
6311 if (nfgtasks.le.1) goto 30
6313 write (iout,'(a)') 'Contact function values before RECEIVE:'
6315 write (iout,'(2i3,50(1x,i2,f5.2))') &
6316 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6321 do i=1,ntask_cont_from
6324 do i=1,ntask_cont_to
6327 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6329 ! Make the list of contacts to send to send to other procesors
6330 do i=iturn3_start,iturn3_end
6331 ! write (iout,*) "make contact list turn3",i," num_cont",
6333 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6335 do i=iturn4_start,iturn4_end
6336 ! write (iout,*) "make contact list turn4",i," num_cont",
6338 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6342 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
6344 do j=1,num_cont_hb(i)
6347 iproc=iint_sent_local(k,jjc,ii)
6348 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6349 if (iproc.ne.0) then
6350 ncont_sent(iproc)=ncont_sent(iproc)+1
6351 nn=ncont_sent(iproc)
6353 zapas(2,nn,iproc)=jjc
6354 zapas(3,nn,iproc)=d_cont(j,i)
6358 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6363 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6371 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6382 "Numbers of contacts to be sent to other processors",&
6383 (ncont_sent(i),i=1,ntask_cont_to)
6384 write (iout,*) "Contacts sent"
6385 do ii=1,ntask_cont_to
6387 iproc=itask_cont_to(ii)
6388 write (iout,*) nn," contacts to processor",iproc,&
6389 " of CONT_TO_COMM group"
6391 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6399 CorrelID1=nfgtasks+fg_rank+1
6401 ! Receive the numbers of needed contacts from other processors
6402 do ii=1,ntask_cont_from
6403 iproc=itask_cont_from(ii)
6405 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
6406 FG_COMM,req(ireq),IERR)
6408 ! write (iout,*) "IRECV ended"
6410 ! Send the number of contacts needed by other processors
6411 do ii=1,ntask_cont_to
6412 iproc=itask_cont_to(ii)
6414 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
6415 FG_COMM,req(ireq),IERR)
6417 ! write (iout,*) "ISEND ended"
6418 ! write (iout,*) "number of requests (nn)",ireq
6421 call MPI_Waitall(ireq,req,status_array,ierr)
6423 ! & "Numbers of contacts to be received from other processors",
6424 ! & (ncont_recv(i),i=1,ntask_cont_from)
6428 do ii=1,ntask_cont_from
6429 iproc=itask_cont_from(ii)
6431 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
6432 ! & " of CONT_TO_COMM group"
6436 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
6437 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6438 ! write (iout,*) "ireq,req",ireq,req(ireq)
6441 ! Send the contacts to processors that need them
6442 do ii=1,ntask_cont_to
6443 iproc=itask_cont_to(ii)
6445 ! write (iout,*) nn," contacts to processor",iproc,
6446 ! & " of CONT_TO_COMM group"
6449 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
6450 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6451 ! write (iout,*) "ireq,req",ireq,req(ireq)
6453 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6457 ! write (iout,*) "number of requests (contacts)",ireq
6458 ! write (iout,*) "req",(req(i),i=1,4)
6461 call MPI_Waitall(ireq,req,status_array,ierr)
6462 do iii=1,ntask_cont_from
6463 iproc=itask_cont_from(iii)
6466 write (iout,*) "Received",nn," contacts from processor",iproc,&
6467 " of CONT_FROM_COMM group"
6470 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6475 ii=zapas_recv(1,i,iii)
6476 ! Flag the received contacts to prevent double-counting
6477 jj=-zapas_recv(2,i,iii)
6478 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6480 nnn=num_cont_hb(ii)+1
6483 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6487 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6492 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6500 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6509 write (iout,'(a)') 'Contact function values after receive:'
6511 write (iout,'(2i3,50(1x,i3,5f6.3))') &
6512 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
6513 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6520 write (iout,'(a)') 'Contact function values:'
6522 write (iout,'(2i3,50(1x,i2,5f6.3))') &
6523 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
6524 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6531 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6532 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6533 ! Remove the loop below after debugging !!!
6540 ! Calculate the dipole-dipole interaction energies
6541 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6542 do i=iatel_s,iatel_e+1
6543 num_conti=num_cont_hb(i)
6552 ! Calculate the local-electrostatic correlation terms
6553 ! write (iout,*) "gradcorr5 in eello5 before loop"
6555 ! write (iout,'(i5,3f10.5)')
6556 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6558 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6559 ! write (iout,*) "corr loop i",i
6561 num_conti=num_cont_hb(i)
6562 num_conti1=num_cont_hb(i+1)
6569 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6570 ! & ' jj=',jj,' kk=',kk
6571 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
6572 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
6573 .or. j.lt.0 .and. j1.gt.0) .and. &
6574 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6575 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6576 ! The system gains extra energy.
6578 sqd1=dsqrt(d_cont(jj,i))
6579 sqd2=dsqrt(d_cont(kk,i1))
6580 sred_geom = sqd1*sqd2
6581 IF (sred_geom.lt.cutoff_corr) THEN
6582 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
6584 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6585 !d & ' jj=',jj,' kk=',kk
6586 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6587 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6589 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6590 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6593 !d write (iout,*) 'sred_geom=',sred_geom,
6594 !d & ' ekont=',ekont,' fprim=',fprimcont,
6595 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6596 !d write (iout,*) "g_contij",g_contij
6597 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6598 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6599 call calc_eello(i,jp,i+1,jp1,jj,kk)
6600 if (wcorr4.gt.0.0d0) &
6601 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6602 if (energy_dec.and.wcorr4.gt.0.0d0) &
6603 write (iout,'(a6,4i5,0pf7.3)') &
6604 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6605 ! write (iout,*) "gradcorr5 before eello5"
6607 ! write (iout,'(i5,3f10.5)')
6608 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6610 if (wcorr5.gt.0.0d0) &
6611 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6612 ! write (iout,*) "gradcorr5 after eello5"
6614 ! write (iout,'(i5,3f10.5)')
6615 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6617 if (energy_dec.and.wcorr5.gt.0.0d0) &
6618 write (iout,'(a6,4i5,0pf7.3)') &
6619 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6620 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6621 !d write(2,*)'ijkl',i,jp,i+1,jp1
6622 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
6623 .or. wturn6.eq.0.0d0))then
6624 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6625 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6626 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
6627 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6628 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6629 !d & 'ecorr6=',ecorr6
6630 !d write (iout,'(4e15.5)') sred_geom,
6631 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6632 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6633 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6634 else if (wturn6.gt.0.0d0 &
6635 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6636 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6637 eturn6=eturn6+eello_turn6(i,jj,kk)
6638 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
6639 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6640 !d write (2,*) 'multibody_eello:eturn6',eturn6
6649 num_cont_hb(i)=num_cont_hb_old(i)
6651 ! write (iout,*) "gradcorr5 in eello5"
6653 ! write (iout,'(i5,3f10.5)')
6654 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6657 end subroutine multibody_eello
6658 !-----------------------------------------------------------------------------
6659 subroutine add_hb_contact_eello(ii,jj,itask)
6660 ! implicit real*8 (a-h,o-z)
6661 ! include "DIMENSIONS"
6662 ! include "COMMON.IOUNITS"
6663 ! include "COMMON.CONTACTS"
6664 ! integer,parameter :: maxconts=nres/4
6665 integer,parameter :: max_dim=70
6666 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
6667 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6668 ! common /przechowalnia/ zapas
6670 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
6671 integer,dimension(4) ::itask
6672 ! write (iout,*) "itask",itask
6675 if (iproc.gt.0) then
6676 do j=1,num_cont_hb(ii)
6678 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6680 ncont_sent(iproc)=ncont_sent(iproc)+1
6681 nn=ncont_sent(iproc)
6682 zapas(1,nn,iproc)=ii
6683 zapas(2,nn,iproc)=jjc
6684 zapas(3,nn,iproc)=d_cont(j,ii)
6688 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6693 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6701 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6712 end subroutine add_hb_contact_eello
6713 !-----------------------------------------------------------------------------
6714 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6715 ! implicit real*8 (a-h,o-z)
6716 ! include 'DIMENSIONS'
6717 ! include 'COMMON.IOUNITS'
6718 ! include 'COMMON.DERIV'
6719 ! include 'COMMON.INTERACT'
6720 ! include 'COMMON.CONTACTS'
6721 real(kind=8),dimension(3) :: gx,gx1
6724 integer :: i,j,k,l,jj,kk,ll
6725 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
6726 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
6727 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl
6737 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6738 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6739 ! Following 4 lines for diagnostics.
6744 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6745 ! & 'Contacts ',i,j,
6746 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6747 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6749 ! Calculate the multi-body contribution to energy.
6750 ! ecorr=ecorr+ekont*ees
6751 ! Calculate multi-body contributions to the gradient.
6752 coeffpees0pij=coeffp*ees0pij
6753 coeffmees0mij=coeffm*ees0mij
6754 coeffpees0pkl=coeffp*ees0pkl
6755 coeffmees0mkl=coeffm*ees0mkl
6757 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6758 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
6759 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
6760 coeffmees0mkl*gacontm_hb1(ll,jj,i))
6761 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
6762 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
6763 coeffmees0mkl*gacontm_hb2(ll,jj,i))
6764 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6765 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
6766 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
6767 coeffmees0mij*gacontm_hb1(ll,kk,k))
6768 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
6769 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
6770 coeffmees0mij*gacontm_hb2(ll,kk,k))
6771 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
6772 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
6773 coeffmees0mkl*gacontm_hb3(ll,jj,i))
6774 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6775 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6776 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
6777 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
6778 coeffmees0mij*gacontm_hb3(ll,kk,k))
6779 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6780 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6781 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6786 !grad gradcorr(ll,m)=gradcorr(ll,m)+
6787 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
6788 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6789 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6794 !grad gradcorr(ll,m)=gradcorr(ll,m)+
6795 !grad & ees*eij*gacont_hbr(ll,kk,k)-
6796 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6797 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6800 ! write (iout,*) "ehbcorr",ekont*ees
6803 end function ehbcorr
6805 !-----------------------------------------------------------------------------
6806 subroutine dipole(i,j,jj)
6807 ! implicit real*8 (a-h,o-z)
6808 ! include 'DIMENSIONS'
6809 ! include 'COMMON.IOUNITS'
6810 ! include 'COMMON.CHAIN'
6811 ! include 'COMMON.FFIELD'
6812 ! include 'COMMON.DERIV'
6813 ! include 'COMMON.INTERACT'
6814 ! include 'COMMON.CONTACTS'
6815 ! include 'COMMON.TORSION'
6816 ! include 'COMMON.VAR'
6817 ! include 'COMMON.GEO'
6818 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
6819 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
6820 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
6822 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
6823 allocate(dipderx(3,5,4,maxconts,nres))
6826 iti1 = itortyp(itype(i+1))
6827 if (j.lt.nres-1) then
6828 itj1 = itortyp(itype(j+1))
6833 dipi(iii,1)=Ub2(iii,i)
6834 dipderi(iii)=Ub2der(iii,i)
6835 dipi(iii,2)=b1(iii,iti1)
6836 dipj(iii,1)=Ub2(iii,j)
6837 dipderj(iii)=Ub2der(iii,j)
6838 dipj(iii,2)=b1(iii,itj1)
6842 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6845 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6852 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
6856 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6861 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6862 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6864 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6866 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6868 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6871 end subroutine dipole
6873 !-----------------------------------------------------------------------------
6874 subroutine calc_eello(i,j,k,l,jj,kk)
6876 ! This subroutine computes matrices and vectors needed to calculate
6877 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
6880 ! implicit real*8 (a-h,o-z)
6881 ! include 'DIMENSIONS'
6882 ! include 'COMMON.IOUNITS'
6883 ! include 'COMMON.CHAIN'
6884 ! include 'COMMON.DERIV'
6885 ! include 'COMMON.INTERACT'
6886 ! include 'COMMON.CONTACTS'
6887 ! include 'COMMON.TORSION'
6888 ! include 'COMMON.VAR'
6889 ! include 'COMMON.GEO'
6890 ! include 'COMMON.FFIELD'
6891 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
6892 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
6893 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
6896 !el common /kutas/ lprn
6897 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6898 !d & ' jj=',jj,' kk=',kk
6899 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6900 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6901 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6904 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6905 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6908 call transpose2(aa1(1,1),aa1t(1,1))
6909 call transpose2(aa2(1,1),aa2t(1,1))
6912 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
6913 aa1tder(1,1,lll,kkk))
6914 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
6915 aa2tder(1,1,lll,kkk))
6919 ! parallel orientation of the two CA-CA-CA frames.
6921 iti=itortyp(itype(i))
6925 itk1=itortyp(itype(k+1))
6926 itj=itortyp(itype(j))
6927 if (l.lt.nres-1) then
6928 itl1=itortyp(itype(l+1))
6932 ! A1 kernel(j+1) A2T
6934 !d write (iout,'(3f10.5,5x,3f10.5)')
6935 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6937 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
6938 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
6939 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6940 ! Following matrices are needed only for 6-th order cumulants
6941 IF (wcorr6.gt.0.0d0) THEN
6942 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
6943 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
6944 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6945 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
6946 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
6947 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
6948 ADtEAderx(1,1,1,1,1,1))
6950 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
6951 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
6952 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
6953 ADtEA1derx(1,1,1,1,1,1))
6955 ! End 6-th order cumulants
6958 !d write (2,*) 'In calc_eello6'
6960 !d write (2,*) 'iii=',iii
6962 !d write (2,*) 'kkk=',kkk
6964 !d write (2,'(3(2f10.5),5x)')
6965 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6970 call transpose2(EUgder(1,1,k),auxmat(1,1))
6971 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6972 call transpose2(EUg(1,1,k),auxmat(1,1))
6973 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6974 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6978 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
6979 EAEAderx(1,1,lll,kkk,iii,1))
6983 ! A1T kernel(i+1) A2
6984 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
6985 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
6986 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6987 ! Following matrices are needed only for 6-th order cumulants
6988 IF (wcorr6.gt.0.0d0) THEN
6989 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
6990 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
6991 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6992 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
6993 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
6994 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
6995 ADtEAderx(1,1,1,1,1,2))
6996 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
6997 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
6998 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
6999 ADtEA1derx(1,1,1,1,1,2))
7001 ! End 6-th order cumulants
7002 call transpose2(EUgder(1,1,l),auxmat(1,1))
7003 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7004 call transpose2(EUg(1,1,l),auxmat(1,1))
7005 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7006 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7010 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7011 EAEAderx(1,1,lll,kkk,iii,2))
7016 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7017 ! They are needed only when the fifth- or the sixth-order cumulants are
7019 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7020 call transpose2(AEA(1,1,1),auxmat(1,1))
7021 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7022 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7023 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7024 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7025 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7026 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7027 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7028 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7029 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7030 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7031 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7032 call transpose2(AEA(1,1,2),auxmat(1,1))
7033 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7034 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7035 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7036 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7037 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7038 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7039 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7040 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7041 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7042 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7043 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7044 ! Calculate the Cartesian derivatives of the vectors.
7048 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7049 call matvec2(auxmat(1,1),b1(1,iti),&
7050 AEAb1derx(1,lll,kkk,iii,1,1))
7051 call matvec2(auxmat(1,1),Ub2(1,i),&
7052 AEAb2derx(1,lll,kkk,iii,1,1))
7053 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
7054 AEAb1derx(1,lll,kkk,iii,2,1))
7055 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
7056 AEAb2derx(1,lll,kkk,iii,2,1))
7057 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7058 call matvec2(auxmat(1,1),b1(1,itj),&
7059 AEAb1derx(1,lll,kkk,iii,1,2))
7060 call matvec2(auxmat(1,1),Ub2(1,j),&
7061 AEAb2derx(1,lll,kkk,iii,1,2))
7062 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
7063 AEAb1derx(1,lll,kkk,iii,2,2))
7064 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
7065 AEAb2derx(1,lll,kkk,iii,2,2))
7072 ! Antiparallel orientation of the two CA-CA-CA frames.
7074 iti=itortyp(itype(i))
7078 itk1=itortyp(itype(k+1))
7079 itl=itortyp(itype(l))
7080 itj=itortyp(itype(j))
7081 if (j.lt.nres-1) then
7082 itj1=itortyp(itype(j+1))
7086 ! A2 kernel(j-1)T A1T
7087 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7088 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
7089 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7090 ! Following matrices are needed only for 6-th order cumulants
7091 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
7092 j.eq.i+4 .and. l.eq.i+3)) THEN
7093 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7094 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
7095 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7096 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7097 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
7098 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
7099 ADtEAderx(1,1,1,1,1,1))
7100 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7101 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
7102 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
7103 ADtEA1derx(1,1,1,1,1,1))
7105 ! End 6-th order cumulants
7106 call transpose2(EUgder(1,1,k),auxmat(1,1))
7107 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7108 call transpose2(EUg(1,1,k),auxmat(1,1))
7109 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7110 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7114 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7115 EAEAderx(1,1,lll,kkk,iii,1))
7119 ! A2T kernel(i+1)T A1
7120 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7121 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
7122 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7123 ! Following matrices are needed only for 6-th order cumulants
7124 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
7125 j.eq.i+4 .and. l.eq.i+3)) THEN
7126 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7127 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
7128 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7129 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7130 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
7131 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
7132 ADtEAderx(1,1,1,1,1,2))
7133 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7134 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
7135 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
7136 ADtEA1derx(1,1,1,1,1,2))
7138 ! End 6-th order cumulants
7139 call transpose2(EUgder(1,1,j),auxmat(1,1))
7140 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7141 call transpose2(EUg(1,1,j),auxmat(1,1))
7142 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7143 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7147 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7148 EAEAderx(1,1,lll,kkk,iii,2))
7153 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7154 ! They are needed only when the fifth- or the sixth-order cumulants are
7156 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
7157 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7158 call transpose2(AEA(1,1,1),auxmat(1,1))
7159 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7160 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7161 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7162 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7163 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7164 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7165 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7166 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7167 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7168 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7169 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7170 call transpose2(AEA(1,1,2),auxmat(1,1))
7171 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7172 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7173 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7174 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7175 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7176 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7177 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7178 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7179 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7180 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7181 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7182 ! Calculate the Cartesian derivatives of the vectors.
7186 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7187 call matvec2(auxmat(1,1),b1(1,iti),&
7188 AEAb1derx(1,lll,kkk,iii,1,1))
7189 call matvec2(auxmat(1,1),Ub2(1,i),&
7190 AEAb2derx(1,lll,kkk,iii,1,1))
7191 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
7192 AEAb1derx(1,lll,kkk,iii,2,1))
7193 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
7194 AEAb2derx(1,lll,kkk,iii,2,1))
7195 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7196 call matvec2(auxmat(1,1),b1(1,itl),&
7197 AEAb1derx(1,lll,kkk,iii,1,2))
7198 call matvec2(auxmat(1,1),Ub2(1,l),&
7199 AEAb2derx(1,lll,kkk,iii,1,2))
7200 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
7201 AEAb1derx(1,lll,kkk,iii,2,2))
7202 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
7203 AEAb2derx(1,lll,kkk,iii,2,2))
7211 end subroutine calc_eello
7212 !-----------------------------------------------------------------------------
7213 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
7218 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
7219 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
7220 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
7221 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
7222 integer :: iii,kkk,lll
7225 !el common /kutas/ lprn
7226 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7228 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
7231 !d if (lprn) write (2,*) 'In kernel'
7233 !d if (lprn) write (2,*) 'kkk=',kkk
7235 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
7236 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7238 !d write (2,*) 'lll=',lll
7239 !d write (2,*) 'iii=1'
7241 !d write (2,'(3(2f10.5),5x)')
7242 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7245 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
7246 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7248 !d write (2,*) 'lll=',lll
7249 !d write (2,*) 'iii=2'
7251 !d write (2,'(3(2f10.5),5x)')
7252 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7258 end subroutine kernel
7259 !-----------------------------------------------------------------------------
7260 real(kind=8) function eello4(i,j,k,l,jj,kk)
7261 ! implicit real*8 (a-h,o-z)
7262 ! include 'DIMENSIONS'
7263 ! include 'COMMON.IOUNITS'
7264 ! include 'COMMON.CHAIN'
7265 ! include 'COMMON.DERIV'
7266 ! include 'COMMON.INTERACT'
7267 ! include 'COMMON.CONTACTS'
7268 ! include 'COMMON.TORSION'
7269 ! include 'COMMON.VAR'
7270 ! include 'COMMON.GEO'
7271 real(kind=8),dimension(2,2) :: pizda
7272 real(kind=8),dimension(3) :: ggg1,ggg2
7273 real(kind=8) :: eel4,glongij,glongkl
7274 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
7275 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7279 !d print *,'eello4:',i,j,k,l,jj,kk
7280 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
7281 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
7282 !old eij=facont_hb(jj,i)
7283 !old ekl=facont_hb(kk,k)
7285 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7286 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7287 gcorr_loc(k-1)=gcorr_loc(k-1) &
7288 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7290 gcorr_loc(l-1)=gcorr_loc(l-1) &
7291 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7293 gcorr_loc(j-1)=gcorr_loc(j-1) &
7294 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7299 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
7300 -EAEAderx(2,2,lll,kkk,iii,1)
7301 !d derx(lll,kkk,iii)=0.0d0
7305 !d gcorr_loc(l-1)=0.0d0
7306 !d gcorr_loc(j-1)=0.0d0
7307 !d gcorr_loc(k-1)=0.0d0
7309 !d write (iout,*)'Contacts have occurred for peptide groups',
7310 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
7311 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7312 if (j.lt.nres-1) then
7319 if (l.lt.nres-1) then
7327 !grad ggg1(ll)=eel4*g_contij(ll,1)
7328 !grad ggg2(ll)=eel4*g_contij(ll,2)
7329 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7330 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7331 !grad ghalf=0.5d0*ggg1(ll)
7332 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7333 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7334 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7335 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7336 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7337 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7338 !grad ghalf=0.5d0*ggg2(ll)
7339 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7340 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7341 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7342 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7343 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7344 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7348 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7353 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7358 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7363 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7367 !d write (2,*) iii,gcorr_loc(iii)
7370 !d write (2,*) 'ekont',ekont
7371 !d write (iout,*) 'eello4',ekont*eel4
7374 !-----------------------------------------------------------------------------
7375 real(kind=8) function eello5(i,j,k,l,jj,kk)
7376 ! implicit real*8 (a-h,o-z)
7377 ! include 'DIMENSIONS'
7378 ! include 'COMMON.IOUNITS'
7379 ! include 'COMMON.CHAIN'
7380 ! include 'COMMON.DERIV'
7381 ! include 'COMMON.INTERACT'
7382 ! include 'COMMON.CONTACTS'
7383 ! include 'COMMON.TORSION'
7384 ! include 'COMMON.VAR'
7385 ! include 'COMMON.GEO'
7386 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
7387 real(kind=8),dimension(2) :: vv
7388 real(kind=8),dimension(3) :: ggg1,ggg2
7389 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
7390 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
7391 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
7392 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7397 ! /l\ / \ \ / \ / \ / C
7398 ! / \ / \ \ / \ / \ / C
7399 ! j| o |l1 | o | o| o | | o |o C
7400 ! \ |/k\| |/ \| / |/ \| |/ \| C
7401 ! \i/ \ / \ / / \ / \ C
7403 ! (I) (II) (III) (IV) C
7405 ! eello5_1 eello5_2 eello5_3 eello5_4 C
7407 ! Antiparallel chains C
7410 ! /j\ / \ \ / \ / \ / C
7411 ! / \ / \ \ / \ / \ / C
7412 ! j1| o |l | o | o| o | | o |o C
7413 ! \ |/k\| |/ \| / |/ \| |/ \| C
7414 ! \i/ \ / \ / / \ / \ C
7416 ! (I) (II) (III) (IV) C
7418 ! eello5_1 eello5_2 eello5_3 eello5_4 C
7420 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
7422 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7423 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7428 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7430 itk=itortyp(itype(k))
7431 itl=itortyp(itype(l))
7432 itj=itortyp(itype(j))
7437 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7438 !d & eel5_3_num,eel5_4_num)
7442 derx(lll,kkk,iii)=0.0d0
7446 !d eij=facont_hb(jj,i)
7447 !d ekl=facont_hb(kk,k)
7449 !d write (iout,*)'Contacts have occurred for peptide groups',
7450 !d & i,j,' fcont:',eij,' eij',' and ',k,l
7452 ! Contribution from the graph I.
7453 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7454 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7455 call transpose2(EUg(1,1,k),auxmat(1,1))
7456 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7457 vv(1)=pizda(1,1)-pizda(2,2)
7458 vv(2)=pizda(1,2)+pizda(2,1)
7459 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
7460 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7461 ! Explicit gradient in virtual-dihedral angles.
7462 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
7463 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
7464 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7465 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7466 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7467 vv(1)=pizda(1,1)-pizda(2,2)
7468 vv(2)=pizda(1,2)+pizda(2,1)
7469 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7470 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
7471 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7472 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7473 vv(1)=pizda(1,1)-pizda(2,2)
7474 vv(2)=pizda(1,2)+pizda(2,1)
7476 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7477 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
7478 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7480 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7481 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
7482 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7484 ! Cartesian gradient
7488 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
7490 vv(1)=pizda(1,1)-pizda(2,2)
7491 vv(2)=pizda(1,2)+pizda(2,1)
7492 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7493 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
7494 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7500 ! Contribution from graph II
7501 call transpose2(EE(1,1,itk),auxmat(1,1))
7502 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7503 vv(1)=pizda(1,1)+pizda(2,2)
7504 vv(2)=pizda(2,1)-pizda(1,2)
7505 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
7506 -0.5d0*scalar2(vv(1),Ctobr(1,k))
7507 ! Explicit gradient in virtual-dihedral angles.
7508 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7509 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7510 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7511 vv(1)=pizda(1,1)+pizda(2,2)
7512 vv(2)=pizda(2,1)-pizda(1,2)
7514 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7515 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
7516 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7518 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7519 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
7520 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7522 ! Cartesian gradient
7526 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7528 vv(1)=pizda(1,1)+pizda(2,2)
7529 vv(2)=pizda(2,1)-pizda(1,2)
7530 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7531 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
7532 -0.5d0*scalar2(vv(1),Ctobr(1,k))
7540 ! Parallel orientation
7541 ! Contribution from graph III
7542 call transpose2(EUg(1,1,l),auxmat(1,1))
7543 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7544 vv(1)=pizda(1,1)-pizda(2,2)
7545 vv(2)=pizda(1,2)+pizda(2,1)
7546 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
7547 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7548 ! Explicit gradient in virtual-dihedral angles.
7549 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7550 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
7551 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7552 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7553 vv(1)=pizda(1,1)-pizda(2,2)
7554 vv(2)=pizda(1,2)+pizda(2,1)
7555 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7556 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
7557 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7558 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7559 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7560 vv(1)=pizda(1,1)-pizda(2,2)
7561 vv(2)=pizda(1,2)+pizda(2,1)
7562 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7563 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
7564 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7565 ! Cartesian gradient
7569 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
7571 vv(1)=pizda(1,1)-pizda(2,2)
7572 vv(2)=pizda(1,2)+pizda(2,1)
7573 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7574 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
7575 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7580 ! Contribution from graph IV
7582 call transpose2(EE(1,1,itl),auxmat(1,1))
7583 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7584 vv(1)=pizda(1,1)+pizda(2,2)
7585 vv(2)=pizda(2,1)-pizda(1,2)
7586 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
7587 -0.5d0*scalar2(vv(1),Ctobr(1,l))
7588 ! Explicit gradient in virtual-dihedral angles.
7589 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7590 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7591 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7592 vv(1)=pizda(1,1)+pizda(2,2)
7593 vv(2)=pizda(2,1)-pizda(1,2)
7594 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7595 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
7596 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7597 ! Cartesian gradient
7601 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7603 vv(1)=pizda(1,1)+pizda(2,2)
7604 vv(2)=pizda(2,1)-pizda(1,2)
7605 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7606 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
7607 -0.5d0*scalar2(vv(1),Ctobr(1,l))
7612 ! Antiparallel orientation
7613 ! Contribution from graph III
7615 call transpose2(EUg(1,1,j),auxmat(1,1))
7616 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7617 vv(1)=pizda(1,1)-pizda(2,2)
7618 vv(2)=pizda(1,2)+pizda(2,1)
7619 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
7620 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7621 ! Explicit gradient in virtual-dihedral angles.
7622 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7623 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
7624 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7625 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7626 vv(1)=pizda(1,1)-pizda(2,2)
7627 vv(2)=pizda(1,2)+pizda(2,1)
7628 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7629 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
7630 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7631 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7632 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7633 vv(1)=pizda(1,1)-pizda(2,2)
7634 vv(2)=pizda(1,2)+pizda(2,1)
7635 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7636 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
7637 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7638 ! Cartesian gradient
7642 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
7644 vv(1)=pizda(1,1)-pizda(2,2)
7645 vv(2)=pizda(1,2)+pizda(2,1)
7646 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
7647 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
7648 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7653 ! Contribution from graph IV
7655 call transpose2(EE(1,1,itj),auxmat(1,1))
7656 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7657 vv(1)=pizda(1,1)+pizda(2,2)
7658 vv(2)=pizda(2,1)-pizda(1,2)
7659 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
7660 -0.5d0*scalar2(vv(1),Ctobr(1,j))
7661 ! Explicit gradient in virtual-dihedral angles.
7662 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7663 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7664 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7665 vv(1)=pizda(1,1)+pizda(2,2)
7666 vv(2)=pizda(2,1)-pizda(1,2)
7667 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7668 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
7669 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7670 ! Cartesian gradient
7674 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7676 vv(1)=pizda(1,1)+pizda(2,2)
7677 vv(2)=pizda(2,1)-pizda(1,2)
7678 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
7679 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
7680 -0.5d0*scalar2(vv(1),Ctobr(1,j))
7686 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7687 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7688 !d write (2,*) 'ijkl',i,j,k,l
7689 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7690 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
7692 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7693 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7694 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7695 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7696 if (j.lt.nres-1) then
7703 if (l.lt.nres-1) then
7713 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7714 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
7715 ! summed up outside the subrouine as for the other subroutines
7716 ! handling long-range interactions. The old code is commented out
7717 ! with "cgrad" to keep track of changes.
7719 !grad ggg1(ll)=eel5*g_contij(ll,1)
7720 !grad ggg2(ll)=eel5*g_contij(ll,2)
7721 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7722 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7723 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7724 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7725 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7726 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7727 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7728 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7730 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7731 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7732 !grad ghalf=0.5d0*ggg1(ll)
7734 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7735 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7736 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7737 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7738 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7739 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7740 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7741 !grad ghalf=0.5d0*ggg2(ll)
7743 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7744 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7745 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7746 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7747 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7748 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7753 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7754 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7759 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7760 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7766 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7771 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7775 !d write (2,*) iii,g_corr5_loc(iii)
7778 !d write (2,*) 'ekont',ekont
7779 !d write (iout,*) 'eello5',ekont*eel5
7782 !-----------------------------------------------------------------------------
7783 real(kind=8) function eello6(i,j,k,l,jj,kk)
7784 ! implicit real*8 (a-h,o-z)
7785 ! include 'DIMENSIONS'
7786 ! include 'COMMON.IOUNITS'
7787 ! include 'COMMON.CHAIN'
7788 ! include 'COMMON.DERIV'
7789 ! include 'COMMON.INTERACT'
7790 ! include 'COMMON.CONTACTS'
7791 ! include 'COMMON.TORSION'
7792 ! include 'COMMON.VAR'
7793 ! include 'COMMON.GEO'
7794 ! include 'COMMON.FFIELD'
7795 real(kind=8),dimension(3) :: ggg1,ggg2
7796 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
7798 real(kind=8) :: gradcorr6ij,gradcorr6kl
7799 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
7800 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7805 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7813 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7814 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7818 derx(lll,kkk,iii)=0.0d0
7822 !d eij=facont_hb(jj,i)
7823 !d ekl=facont_hb(kk,k)
7829 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7830 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7831 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7832 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7833 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7834 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7836 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7837 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7838 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7839 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7840 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7841 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7845 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7847 ! If turn contributions are considered, they will be handled separately.
7848 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7849 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7850 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7851 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7852 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7853 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7854 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7856 if (j.lt.nres-1) then
7863 if (l.lt.nres-1) then
7871 !grad ggg1(ll)=eel6*g_contij(ll,1)
7872 !grad ggg2(ll)=eel6*g_contij(ll,2)
7873 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7874 !grad ghalf=0.5d0*ggg1(ll)
7876 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7877 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7878 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7879 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7880 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7881 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7882 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7883 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7884 !grad ghalf=0.5d0*ggg2(ll)
7885 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7887 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7888 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7889 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7890 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7891 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7892 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7897 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7898 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7903 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7904 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7910 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7915 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7919 !d write (2,*) iii,g_corr6_loc(iii)
7922 !d write (2,*) 'ekont',ekont
7923 !d write (iout,*) 'eello6',ekont*eel6
7926 !-----------------------------------------------------------------------------
7927 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
7929 ! implicit real*8 (a-h,o-z)
7930 ! include 'DIMENSIONS'
7931 ! include 'COMMON.IOUNITS'
7932 ! include 'COMMON.CHAIN'
7933 ! include 'COMMON.DERIV'
7934 ! include 'COMMON.INTERACT'
7935 ! include 'COMMON.CONTACTS'
7936 ! include 'COMMON.TORSION'
7937 ! include 'COMMON.VAR'
7938 ! include 'COMMON.GEO'
7939 real(kind=8),dimension(2) :: vv,vv1
7940 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
7943 !el common /kutas/ lprn
7944 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
7945 real(kind=8) :: s1,s2,s3,s4,s5
7946 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7948 ! Parallel Antiparallel C
7954 ! \ j|/k\| / \ |/k\|l / C
7959 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7960 itk=itortyp(itype(k))
7961 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7962 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7963 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7964 call transpose2(EUgC(1,1,k),auxmat(1,1))
7965 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7966 vv1(1)=pizda1(1,1)-pizda1(2,2)
7967 vv1(2)=pizda1(1,2)+pizda1(2,1)
7968 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7969 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7970 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7971 s5=scalar2(vv(1),Dtobr2(1,i))
7972 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7973 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7974 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
7975 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
7976 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
7977 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
7978 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
7979 +scalar2(vv(1),Dtobr2der(1,i)))
7980 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7981 vv1(1)=pizda1(1,1)-pizda1(2,2)
7982 vv1(2)=pizda1(1,2)+pizda1(2,1)
7983 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7984 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7986 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
7987 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
7988 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
7989 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
7990 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7992 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
7993 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
7994 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
7995 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
7996 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7998 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7999 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8000 vv1(1)=pizda1(1,1)-pizda1(2,2)
8001 vv1(2)=pizda1(1,2)+pizda1(2,1)
8002 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
8003 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
8004 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
8005 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8014 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8015 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8016 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8017 call transpose2(EUgC(1,1,k),auxmat(1,1))
8018 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
8020 vv1(1)=pizda1(1,1)-pizda1(2,2)
8021 vv1(2)=pizda1(1,2)+pizda1(2,1)
8022 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8023 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
8024 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8025 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
8026 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8027 s5=scalar2(vv(1),Dtobr2(1,i))
8028 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8033 end function eello6_graph1
8034 !-----------------------------------------------------------------------------
8035 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
8037 ! implicit real*8 (a-h,o-z)
8038 ! include 'DIMENSIONS'
8039 ! include 'COMMON.IOUNITS'
8040 ! include 'COMMON.CHAIN'
8041 ! include 'COMMON.DERIV'
8042 ! include 'COMMON.INTERACT'
8043 ! include 'COMMON.CONTACTS'
8044 ! include 'COMMON.TORSION'
8045 ! include 'COMMON.VAR'
8046 ! include 'COMMON.GEO'
8048 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
8049 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8051 !el common /kutas/ lprn
8052 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
8053 real(kind=8) :: s2,s3,s4
8054 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8056 ! Parallel Antiparallel C
8062 ! \ j|/k\| \ |/k\|l C
8067 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8068 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8069 ! AL 7/4/01 s1 would occur in the sixth-order moment,
8070 ! but not in a cluster cumulant
8072 s1=dip(1,jj,i)*dip(1,kk,k)
8074 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8075 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8076 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8077 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8078 call transpose2(EUg(1,1,k),auxmat(1,1))
8079 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8080 vv(1)=pizda(1,1)-pizda(2,2)
8081 vv(2)=pizda(1,2)+pizda(2,1)
8082 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8083 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8085 eello6_graph2=-(s1+s2+s3+s4)
8087 eello6_graph2=-(s2+s3+s4)
8090 ! Derivatives in gamma(i-1)
8093 s1=dipderg(1,jj,i)*dip(1,kk,k)
8095 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8096 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8097 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8098 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8100 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8102 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8104 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8106 ! Derivatives in gamma(k-1)
8108 s1=dip(1,jj,i)*dipderg(1,kk,k)
8110 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8111 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8112 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8113 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8114 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8115 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8116 vv(1)=pizda(1,1)-pizda(2,2)
8117 vv(2)=pizda(1,2)+pizda(2,1)
8118 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8120 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8122 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8124 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8125 ! Derivatives in gamma(j-1) or gamma(l-1)
8128 s1=dipderg(3,jj,i)*dip(1,kk,k)
8130 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8131 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8132 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8133 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8134 vv(1)=pizda(1,1)-pizda(2,2)
8135 vv(2)=pizda(1,2)+pizda(2,1)
8136 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8139 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8141 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8144 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8145 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8147 ! Derivatives in gamma(l-1) or gamma(j-1)
8150 s1=dip(1,jj,i)*dipderg(3,kk,k)
8152 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8153 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8154 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8155 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8156 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8157 vv(1)=pizda(1,1)-pizda(2,2)
8158 vv(2)=pizda(1,2)+pizda(2,1)
8159 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8162 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8164 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8167 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8168 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8170 ! Cartesian derivatives.
8172 write (2,*) 'In eello6_graph2'
8174 write (2,*) 'iii=',iii
8176 write (2,*) 'kkk=',kkk
8178 write (2,'(3(2f10.5),5x)') &
8179 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8189 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8191 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8194 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
8196 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8197 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
8199 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8200 call transpose2(EUg(1,1,k),auxmat(1,1))
8201 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8203 vv(1)=pizda(1,1)-pizda(2,2)
8204 vv(2)=pizda(1,2)+pizda(2,1)
8205 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8206 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8208 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8210 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8213 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8215 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8221 end function eello6_graph2
8222 !-----------------------------------------------------------------------------
8223 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
8224 ! implicit real*8 (a-h,o-z)
8225 ! include 'DIMENSIONS'
8226 ! include 'COMMON.IOUNITS'
8227 ! include 'COMMON.CHAIN'
8228 ! include 'COMMON.DERIV'
8229 ! include 'COMMON.INTERACT'
8230 ! include 'COMMON.CONTACTS'
8231 ! include 'COMMON.TORSION'
8232 ! include 'COMMON.VAR'
8233 ! include 'COMMON.GEO'
8234 real(kind=8),dimension(2) :: vv,auxvec
8235 real(kind=8),dimension(2,2) :: pizda,auxmat
8237 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
8238 real(kind=8) :: s1,s2,s3,s4
8239 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8241 ! Parallel Antiparallel C
8247 ! j|/k\| / |/k\|l / C
8252 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8254 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
8255 ! energy moment and not to the cluster cumulant.
8256 iti=itortyp(itype(i))
8257 if (j.lt.nres-1) then
8258 itj1=itortyp(itype(j+1))
8262 itk=itortyp(itype(k))
8263 itk1=itortyp(itype(k+1))
8264 if (l.lt.nres-1) then
8265 itl1=itortyp(itype(l+1))
8270 s1=dip(4,jj,i)*dip(4,kk,k)
8272 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8273 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8274 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8275 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8276 call transpose2(EE(1,1,itk),auxmat(1,1))
8277 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8278 vv(1)=pizda(1,1)+pizda(2,2)
8279 vv(2)=pizda(2,1)-pizda(1,2)
8280 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8281 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8282 !d & "sum",-(s2+s3+s4)
8284 eello6_graph3=-(s1+s2+s3+s4)
8286 eello6_graph3=-(s2+s3+s4)
8289 ! Derivatives in gamma(k-1)
8290 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8291 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8292 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8293 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8294 ! Derivatives in gamma(l-1)
8295 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8296 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8297 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8298 vv(1)=pizda(1,1)+pizda(2,2)
8299 vv(2)=pizda(2,1)-pizda(1,2)
8300 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8301 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8302 ! Cartesian derivatives.
8308 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8310 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8313 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8315 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8316 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8318 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8319 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
8321 vv(1)=pizda(1,1)+pizda(2,2)
8322 vv(2)=pizda(2,1)-pizda(1,2)
8323 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8325 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8327 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8330 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8332 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8334 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8339 end function eello6_graph3
8340 !-----------------------------------------------------------------------------
8341 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8342 ! implicit real*8 (a-h,o-z)
8343 ! include 'DIMENSIONS'
8344 ! include 'COMMON.IOUNITS'
8345 ! include 'COMMON.CHAIN'
8346 ! include 'COMMON.DERIV'
8347 ! include 'COMMON.INTERACT'
8348 ! include 'COMMON.CONTACTS'
8349 ! include 'COMMON.TORSION'
8350 ! include 'COMMON.VAR'
8351 ! include 'COMMON.GEO'
8352 ! include 'COMMON.FFIELD'
8353 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
8354 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8356 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
8358 real(kind=8) :: s1,s2,s3,s4
8359 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8361 ! Parallel Antiparallel C
8367 ! \ j|/k\| \ |/k\|l C
8372 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8374 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
8375 ! energy moment and not to the cluster cumulant.
8376 !d write (2,*) 'eello_graph4: wturn6',wturn6
8377 iti=itortyp(itype(i))
8378 itj=itortyp(itype(j))
8379 if (j.lt.nres-1) then
8380 itj1=itortyp(itype(j+1))
8384 itk=itortyp(itype(k))
8385 if (k.lt.nres-1) then
8386 itk1=itortyp(itype(k+1))
8390 itl=itortyp(itype(l))
8391 if (l.lt.nres-1) then
8392 itl1=itortyp(itype(l+1))
8396 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8397 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8398 !d & ' itl',itl,' itl1',itl1
8401 s1=dip(3,jj,i)*dip(3,kk,k)
8403 s1=dip(2,jj,j)*dip(2,kk,l)
8406 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8407 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8409 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8410 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8412 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8413 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8415 call transpose2(EUg(1,1,k),auxmat(1,1))
8416 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8417 vv(1)=pizda(1,1)-pizda(2,2)
8418 vv(2)=pizda(2,1)+pizda(1,2)
8419 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8420 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8422 eello6_graph4=-(s1+s2+s3+s4)
8424 eello6_graph4=-(s2+s3+s4)
8426 ! Derivatives in gamma(i-1)
8430 s1=dipderg(2,jj,i)*dip(3,kk,k)
8432 s1=dipderg(4,jj,j)*dip(2,kk,l)
8435 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8437 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8438 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8440 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8441 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8443 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8444 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8445 !d write (2,*) 'turn6 derivatives'
8447 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8449 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8453 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8455 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8459 ! Derivatives in gamma(k-1)
8462 s1=dip(3,jj,i)*dipderg(2,kk,k)
8464 s1=dip(2,jj,j)*dipderg(4,kk,l)
8467 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8468 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8470 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8471 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8473 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8474 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8476 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8477 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8478 vv(1)=pizda(1,1)-pizda(2,2)
8479 vv(2)=pizda(2,1)+pizda(1,2)
8480 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8481 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8483 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8485 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8489 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8491 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8494 ! Derivatives in gamma(j-1) or gamma(l-1)
8495 if (l.eq.j+1 .and. l.gt.1) then
8496 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8497 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8498 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8499 vv(1)=pizda(1,1)-pizda(2,2)
8500 vv(2)=pizda(2,1)+pizda(1,2)
8501 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8502 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8503 else if (j.gt.1) then
8504 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8505 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8506 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8507 vv(1)=pizda(1,1)-pizda(2,2)
8508 vv(2)=pizda(2,1)+pizda(1,2)
8509 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8510 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8511 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8513 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8516 ! Cartesian derivatives.
8523 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8525 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8529 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8531 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8535 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
8537 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8539 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
8540 b1(1,itj1),auxvec(1))
8541 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8543 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
8544 b1(1,itl1),auxvec(1))
8545 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8547 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
8549 vv(1)=pizda(1,1)-pizda(2,2)
8550 vv(2)=pizda(2,1)+pizda(1,2)
8551 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8553 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8555 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
8558 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
8561 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8564 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8566 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8568 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8572 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8574 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8577 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8579 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8586 end function eello6_graph4
8587 !-----------------------------------------------------------------------------
8588 real(kind=8) function eello_turn6(i,jj,kk)
8589 ! implicit real*8 (a-h,o-z)
8590 ! include 'DIMENSIONS'
8591 ! include 'COMMON.IOUNITS'
8592 ! include 'COMMON.CHAIN'
8593 ! include 'COMMON.DERIV'
8594 ! include 'COMMON.INTERACT'
8595 ! include 'COMMON.CONTACTS'
8596 ! include 'COMMON.TORSION'
8597 ! include 'COMMON.VAR'
8598 ! include 'COMMON.GEO'
8599 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
8600 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
8601 real(kind=8),dimension(3) :: ggg1,ggg2
8602 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
8603 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
8604 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8605 ! the respective energy moment and not to the cluster cumulant.
8607 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
8608 integer :: j1,j2,l1,l2,ll
8609 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
8610 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
8619 iti=itortyp(itype(i))
8620 itk=itortyp(itype(k))
8621 itk1=itortyp(itype(k+1))
8622 itl=itortyp(itype(l))
8623 itj=itortyp(itype(j))
8624 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8625 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
8626 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8631 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8633 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
8637 derx_turn(lll,kkk,iii)=0.0d0
8644 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8646 !d write (2,*) 'eello6_5',eello6_5
8648 call transpose2(AEA(1,1,1),auxmat(1,1))
8649 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8650 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8651 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8653 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8654 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8655 s2 = scalar2(b1(1,itk),vtemp1(1))
8657 call transpose2(AEA(1,1,2),atemp(1,1))
8658 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8659 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8660 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8662 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8663 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8664 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8666 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8667 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8668 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8669 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8670 ss13 = scalar2(b1(1,itk),vtemp4(1))
8671 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8673 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8679 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8680 ! Derivatives in gamma(i+2)
8684 call transpose2(AEA(1,1,1),auxmatd(1,1))
8685 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8686 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8687 call transpose2(AEAderg(1,1,2),atempd(1,1))
8688 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8689 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8691 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8692 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8693 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8699 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8700 ! Derivatives in gamma(i+3)
8702 call transpose2(AEA(1,1,1),auxmatd(1,1))
8703 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8704 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8705 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8707 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8708 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8709 s2d = scalar2(b1(1,itk),vtemp1d(1))
8711 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8712 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8714 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8716 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8717 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8718 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8726 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
8727 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8729 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
8730 -0.5d0*ekont*(s2d+s12d)
8732 ! Derivatives in gamma(i+4)
8733 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8734 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8735 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8737 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8738 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8739 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8747 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8749 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8751 ! Derivatives in gamma(i+5)
8753 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8754 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8755 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8757 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8758 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8759 s2d = scalar2(b1(1,itk),vtemp1d(1))
8761 call transpose2(AEA(1,1,2),atempd(1,1))
8762 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8763 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8765 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8766 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8768 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8769 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8770 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8778 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
8779 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8781 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
8782 -0.5d0*ekont*(s2d+s12d)
8784 ! Cartesian derivatives
8789 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8790 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8791 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8793 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8794 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
8796 s2d = scalar2(b1(1,itk),vtemp1d(1))
8798 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8799 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8800 s8d = -(atempd(1,1)+atempd(2,2))* &
8801 scalar2(cc(1,1,itl),vtemp2(1))
8803 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
8805 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8806 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8813 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
8816 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
8820 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
8823 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
8832 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
8834 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8835 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8836 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8837 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8838 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
8840 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8841 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8842 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8846 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8847 !d & 16*eel_turn6_num
8849 if (j.lt.nres-1) then
8856 if (l.lt.nres-1) then
8864 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
8865 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
8866 !grad ghalf=0.5d0*ggg1(ll)
8868 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8869 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8870 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
8871 +ekont*derx_turn(ll,2,1)
8872 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8873 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
8874 +ekont*derx_turn(ll,4,1)
8875 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8876 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8877 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8878 !grad ghalf=0.5d0*ggg2(ll)
8880 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
8881 +ekont*derx_turn(ll,2,2)
8882 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8883 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
8884 +ekont*derx_turn(ll,4,2)
8885 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8886 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8887 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8892 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8897 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8903 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8908 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8912 !d write (2,*) iii,g_corr6_loc(iii)
8914 eello_turn6=ekont*eel_turn6
8915 !d write (2,*) 'ekont',ekont
8916 !d write (2,*) 'eel_turn6',ekont*eel_turn6
8918 end function eello_turn6
8919 !-----------------------------------------------------------------------------
8920 subroutine MATVEC2(A1,V1,V2)
8921 !DIR$ INLINEALWAYS MATVEC2
8923 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8925 ! implicit real*8 (a-h,o-z)
8926 ! include 'DIMENSIONS'
8927 real(kind=8),dimension(2) :: V1,V2
8928 real(kind=8),dimension(2,2) :: A1
8929 real(kind=8) :: vaux1,vaux2
8933 ! 3 VI=VI+A1(I,K)*V1(K)
8937 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8938 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8942 end subroutine MATVEC2
8943 !-----------------------------------------------------------------------------
8944 subroutine MATMAT2(A1,A2,A3)
8946 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8948 ! implicit real*8 (a-h,o-z)
8949 ! include 'DIMENSIONS'
8950 real(kind=8),dimension(2,2) :: A1,A2,A3
8951 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
8952 ! DIMENSION AI3(2,2)
8956 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
8962 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8963 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8964 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8965 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8971 end subroutine MATMAT2
8972 !-----------------------------------------------------------------------------
8973 real(kind=8) function scalar2(u,v)
8974 !DIR$ INLINEALWAYS scalar2
8976 real(kind=8),dimension(2) :: u,v
8979 scalar2=u(1)*v(1)+u(2)*v(2)
8981 end function scalar2
8982 !-----------------------------------------------------------------------------
8983 subroutine transpose2(a,at)
8984 !DIR$ INLINEALWAYS transpose2
8986 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
8989 real(kind=8),dimension(2,2) :: a,at
8995 end subroutine transpose2
8996 !-----------------------------------------------------------------------------
8997 subroutine transpose(n,a,at)
9000 real(kind=8),dimension(n,n) :: a,at
9007 end subroutine transpose
9008 !-----------------------------------------------------------------------------
9009 subroutine prodmat3(a1,a2,kk,transp,prod)
9010 !DIR$ INLINEALWAYS prodmat3
9012 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
9016 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
9018 !rc double precision auxmat(2,2),prod_(2,2)
9021 !rc call transpose2(kk(1,1),auxmat(1,1))
9022 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9023 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9025 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
9026 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9027 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
9028 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9029 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
9030 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9031 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
9032 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9035 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9036 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9038 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
9039 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9040 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
9041 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9042 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
9043 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9044 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
9045 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9048 ! call transpose2(a2(1,1),a2t(1,1))
9051 !rc print *,((prod_(i,j),i=1,2),j=1,2)
9052 !rc print *,((prod(i,j),i=1,2),j=1,2)
9055 end subroutine prodmat3
9056 !-----------------------------------------------------------------------------
9057 ! energy_p_new_barrier.F
9058 !-----------------------------------------------------------------------------
9059 subroutine sum_gradient
9060 ! implicit real*8 (a-h,o-z)
9061 use io_base, only: pdbout
9062 ! include 'DIMENSIONS'
9066 !MS$ATTRIBUTES C :: proc_proc
9072 real(kind=8),dimension(3,nres) :: gradbufc,gradbufx,gradbufc_sum,&
9073 gloc_scbuf !(3,maxres)
9075 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
9078 integer :: i,j,k,ierror,ierr
9079 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
9080 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
9081 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
9082 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
9083 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
9084 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
9085 gsccorr_max,gsccorrx_max,time00
9087 ! include 'COMMON.SETUP'
9088 ! include 'COMMON.IOUNITS'
9089 ! include 'COMMON.FFIELD'
9090 ! include 'COMMON.DERIV'
9091 ! include 'COMMON.INTERACT'
9092 ! include 'COMMON.SBRIDGE'
9093 ! include 'COMMON.CHAIN'
9094 ! include 'COMMON.VAR'
9095 ! include 'COMMON.CONTROL'
9096 ! include 'COMMON.TIME1'
9097 ! include 'COMMON.MAXGRAD'
9098 ! include 'COMMON.SCCOR'
9103 write (iout,*) "sum_gradient gvdwc, gvdwx"
9105 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9106 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
9116 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
9117 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
9118 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
9121 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
9122 ! in virtual-bond-vector coordinates
9125 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
9127 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
9128 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
9130 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
9132 ! write (iout,'(i5,3f10.5,2x,f10.5)')
9133 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
9135 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
9137 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9138 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
9139 (gvdwc_scpp(j,i),j=1,3)
9141 write (iout,*) "gelc_long gvdwpp gel_loc_long"
9143 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9144 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
9145 (gelc_loc_long(j,i),j=1,3)
9152 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
9153 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
9154 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
9155 wel_loc*gel_loc_long(j,i)+ &
9156 wcorr*gradcorr_long(j,i)+ &
9157 wcorr5*gradcorr5_long(j,i)+ &
9158 wcorr6*gradcorr6_long(j,i)+ &
9159 wturn6*gcorr6_turn_long(j,i)+ &
9166 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
9167 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
9168 welec*gelc_long(j,i)+ &
9170 wel_loc*gel_loc_long(j,i)+ &
9171 wcorr*gradcorr_long(j,i)+ &
9172 wcorr5*gradcorr5_long(j,i)+ &
9173 wcorr6*gradcorr6_long(j,i)+ &
9174 wturn6*gcorr6_turn_long(j,i)+ &
9180 if (nfgtasks.gt.1) then
9183 write (iout,*) "gradbufc before allreduce"
9185 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9191 gradbufc_sum(j,i)=gradbufc(j,i)
9194 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
9195 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
9196 ! time_reduce=time_reduce+MPI_Wtime()-time00
9198 ! write (iout,*) "gradbufc_sum after allreduce"
9200 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
9205 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
9213 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
9214 write (iout,*) (i," jgrad_start",jgrad_start(i),&
9215 " jgrad_end ",jgrad_end(i),&
9216 i=igrad_start,igrad_end)
9219 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
9220 ! do not parallelize this part.
9222 ! do i=igrad_start,igrad_end
9223 ! do j=jgrad_start(i),jgrad_end(i)
9225 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
9230 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
9234 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
9238 write (iout,*) "gradbufc after summing"
9240 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9248 write (iout,*) "gradbufc"
9250 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9257 gradbufc_sum(j,i)=gradbufc(j,i)
9262 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
9266 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
9271 ! gradbufc(k,i)=0.0d0
9275 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
9281 write (iout,*) "gradbufc after summing"
9283 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9292 gradbufc(k,nres)=0.0d0
9295 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
9296 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
9297 !el-----------------
9301 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
9302 wel_loc*gel_loc(j,i)+ &
9303 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
9304 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
9305 wel_loc*gel_loc_long(j,i)+ &
9306 wcorr*gradcorr_long(j,i)+ &
9307 wcorr5*gradcorr5_long(j,i)+ &
9308 wcorr6*gradcorr6_long(j,i)+ &
9309 wturn6*gcorr6_turn_long(j,i))+ &
9311 wcorr*gradcorr(j,i)+ &
9312 wturn3*gcorr3_turn(j,i)+ &
9313 wturn4*gcorr4_turn(j,i)+ &
9314 wcorr5*gradcorr5(j,i)+ &
9315 wcorr6*gradcorr6(j,i)+ &
9316 wturn6*gcorr6_turn(j,i)+ &
9317 wsccor*gsccorc(j,i) &
9320 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
9321 wel_loc*gel_loc(j,i)+ &
9322 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
9323 welec*gelc_long(j,i)+ &
9324 wel_loc*gel_loc_long(j,i)+ &
9325 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
9326 wcorr5*gradcorr5_long(j,i)+ &
9327 wcorr6*gradcorr6_long(j,i)+ &
9328 wturn6*gcorr6_turn_long(j,i))+ &
9330 wcorr*gradcorr(j,i)+ &
9331 wturn3*gcorr3_turn(j,i)+ &
9332 wturn4*gcorr4_turn(j,i)+ &
9333 wcorr5*gradcorr5(j,i)+ &
9334 wcorr6*gradcorr6(j,i)+ &
9335 wturn6*gcorr6_turn(j,i)+ &
9336 wsccor*gsccorc(j,i) &
9339 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
9340 wbond*gradbx(j,i)+ &
9341 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
9342 wsccor*gsccorx(j,i) &
9343 +wscloc*gsclocx(j,i)
9347 write (iout,*) "gloc before adding corr"
9349 write (iout,*) i,gloc(i,icg)
9353 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
9354 +wcorr5*g_corr5_loc(i) &
9355 +wcorr6*g_corr6_loc(i) &
9356 +wturn4*gel_loc_turn4(i) &
9357 +wturn3*gel_loc_turn3(i) &
9358 +wturn6*gel_loc_turn6(i) &
9359 +wel_loc*gel_loc_loc(i)
9362 write (iout,*) "gloc after adding corr"
9364 write (iout,*) i,gloc(i,icg)
9368 if (nfgtasks.gt.1) then
9371 gradbufc(j,i)=gradc(j,i,icg)
9372 gradbufx(j,i)=gradx(j,i,icg)
9376 glocbuf(i)=gloc(i,icg)
9380 write (iout,*) "gloc_sc before reduce"
9383 write (iout,*) i,j,gloc_sc(j,i,icg)
9390 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
9394 call MPI_Barrier(FG_COMM,IERR)
9395 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
9397 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,&
9398 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9399 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,&
9400 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9401 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
9402 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9403 time_reduce=time_reduce+MPI_Wtime()-time00
9404 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
9405 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9406 time_reduce=time_reduce+MPI_Wtime()-time00
9409 write (iout,*) "gloc_sc after reduce"
9412 write (iout,*) i,j,gloc_sc(j,i,icg)
9418 write (iout,*) "gloc after reduce"
9420 write (iout,*) i,gloc(i,icg)
9425 if (gnorm_check) then
9427 ! Compute the maximum elements of the gradient
9437 gcorr3_turn_max=0.0d0
9438 gcorr4_turn_max=0.0d0
9441 gcorr6_turn_max=0.0d0
9451 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
9452 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
9453 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
9454 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
9455 gvdwc_scp_max=gvdwc_scp_norm
9456 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
9457 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
9458 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
9459 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
9460 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
9461 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
9462 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
9463 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
9464 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
9465 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
9466 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
9467 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
9468 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
9470 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
9471 gcorr3_turn_max=gcorr3_turn_norm
9472 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
9474 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
9475 gcorr4_turn_max=gcorr4_turn_norm
9476 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
9477 if (gradcorr5_norm.gt.gradcorr5_max) &
9478 gradcorr5_max=gradcorr5_norm
9479 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
9480 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
9481 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
9483 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
9484 gcorr6_turn_max=gcorr6_turn_norm
9485 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
9486 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
9487 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
9488 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
9489 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
9490 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
9491 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
9492 if (gradx_scp_norm.gt.gradx_scp_max) &
9493 gradx_scp_max=gradx_scp_norm
9494 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
9495 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
9496 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
9497 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
9498 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
9499 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
9500 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
9501 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
9505 open(istat,file=statname,position="append")
9507 open(istat,file=statname,access="append")
9509 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
9510 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
9511 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
9512 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
9513 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
9514 gsccorx_max,gsclocx_max
9516 if (gvdwc_max.gt.1.0d4) then
9517 write (iout,*) "gvdwc gvdwx gradb gradbx"
9519 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
9520 gradb(j,i),gradbx(j,i),j=1,3)
9522 call pdbout(0.0d0,'cipiszcze',iout)
9529 write (iout,*) "gradc gradx gloc"
9531 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
9532 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
9537 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
9540 end subroutine sum_gradient
9541 !-----------------------------------------------------------------------------
9543 ! implicit real*8 (a-h,o-z)
9545 ! include 'DIMENSIONS'
9546 ! include 'COMMON.CHAIN'
9547 ! include 'COMMON.DERIV'
9548 ! include 'COMMON.CALC'
9549 ! include 'COMMON.IOUNITS'
9550 real(kind=8), dimension(3) :: dcosom1,dcosom2
9552 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
9553 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
9554 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
9555 -2.0D0*alf12*eps3der+sigder*sigsq_om12
9559 ! eom12=evdwij*eps1_om12
9561 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
9563 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
9564 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
9566 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
9567 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
9570 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
9572 ! write (iout,*) "gg",(gg(k),k=1,3)
9574 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
9575 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
9576 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
9577 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
9578 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
9579 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
9580 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
9581 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
9582 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
9583 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
9586 ! Calculate the components of the gradient in DC and X
9590 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
9594 gvdwc(l,i)=gvdwc(l,i)-gg(l)
9595 gvdwc(l,j)=gvdwc(l,j)+gg(l)
9598 end subroutine sc_grad
9600 !-----------------------------------------------------------------------------
9601 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
9604 ! implicit real*8 (a-h,o-z)
9605 ! include 'DIMENSIONS'
9606 ! include 'COMMON.LOCAL'
9607 ! include 'COMMON.IOUNITS'
9608 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
9609 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
9610 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
9611 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
9612 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
9614 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
9615 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
9616 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
9619 delthec=thetai-thet_pred_mean
9620 delthe0=thetai-theta0i
9621 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
9622 t3 = thetai-thet_pred_mean
9626 t14 = t12+t6*sigsqtc
9628 t21 = thetai-theta0i
9634 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
9635 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
9636 *(-t12*t9-ak*sig0inv*t27)
9638 end subroutine mixder
9640 !-----------------------------------------------------------------------------
9642 !-----------------------------------------------------------------------------
9644 !-----------------------------------------------------------------------------
9645 ! This subroutine calculates the derivatives of the consecutive virtual
9646 ! bond vectors and the SC vectors in the virtual-bond angles theta and
9647 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
9648 ! in the angles alpha and omega, describing the location of a side chain
9649 ! in its local coordinate system.
9651 ! The derivatives are stored in the following arrays:
9653 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
9654 ! The structure is as follows:
9656 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
9657 ! 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)
9658 ! . . . . . . . . . . . . . . . . . .
9659 ! 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)
9663 ! 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)
9665 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
9666 ! The structure is same as above.
9668 ! DCDS - the derivatives of the side chain vectors in the local spherical
9669 ! andgles alph and omega:
9671 ! 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)
9672 ! 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)
9676 ! 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)
9678 ! Version of March '95, based on an early version of November '91.
9680 !**********************************************************************
9681 ! implicit real*8 (a-h,o-z)
9682 ! include 'DIMENSIONS'
9683 ! include 'COMMON.VAR'
9684 ! include 'COMMON.CHAIN'
9685 ! include 'COMMON.DERIV'
9686 ! include 'COMMON.GEO'
9687 ! include 'COMMON.LOCAL'
9688 ! include 'COMMON.INTERACT'
9689 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
9690 real(kind=8),dimension(3,3) :: dp,temp
9691 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
9692 real(kind=8),dimension(3) :: xx,xx1
9694 integer :: i,k,l,j,m,ind,ind1,jjj
9695 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
9696 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
9697 sint2,xp,yp,xxp,yyp,zzp,dj
9699 ! common /przechowalnia/ fromto
9700 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
9701 ! get the position of the jth ijth fragment of the chain coordinate system
9702 ! in the fromto array.
9703 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
9705 ! maxdim=(nres-1)*(nres-2)/2
9706 ! allocate(dcdv(6,maxdim),dxds(6,nres))
9707 ! calculate the derivatives of transformation matrix elements in theta
9710 !el call flush(iout) !el
9712 rdt(1,1,i)=-rt(1,2,i)
9713 rdt(1,2,i)= rt(1,1,i)
9715 rdt(2,1,i)=-rt(2,2,i)
9716 rdt(2,2,i)= rt(2,1,i)
9718 rdt(3,1,i)=-rt(3,2,i)
9719 rdt(3,2,i)= rt(3,1,i)
9723 ! derivatives in phi
9729 drt(2,1,i)= rt(3,1,i)
9730 drt(2,2,i)= rt(3,2,i)
9731 drt(2,3,i)= rt(3,3,i)
9732 drt(3,1,i)=-rt(2,1,i)
9733 drt(3,2,i)=-rt(2,2,i)
9734 drt(3,3,i)=-rt(2,3,i)
9737 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
9748 fromto(k,l,ind)=temp(k,l)
9757 dpkl=dpkl+temp(k,m)*rt(m,l,j)
9760 fromto(k,l,ind)=dpkl
9771 ! Calculate derivatives.
9777 ! Derivatives of DC(i+1) in theta(i+2)
9783 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
9786 prordt(j,k,i)=dp(j,k)
9789 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
9792 ! Derivatives of SC(i+1) in theta(i+2)
9794 xx1(1)=-0.5D0*xloc(2,i+1)
9795 xx1(2)= 0.5D0*xloc(1,i+1)
9799 xj=xj+r(j,k,i)*xx1(k)
9806 rj=rj+prod(j,k,i)*xx(k)
9811 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
9812 ! than the other off-diagonal derivatives.
9817 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
9819 dxdv(j,ind1+1)=dxoiij
9821 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
9823 ! Derivatives of DC(i+1) in phi(i+2)
9829 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
9832 prodrt(j,k,i)=dp(j,k)
9834 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
9837 ! Derivatives of SC(i+1) in phi(i+2)
9840 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
9841 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
9845 rj=rj+prod(j,k,i)*xx(k)
9850 ! Derivatives of SC(i+1) in phi(i+3).
9855 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
9857 dxdv(j+3,ind1+1)=dxoiij
9860 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
9861 ! theta(nres) and phi(i+3) thru phi(nres).
9866 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
9871 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
9876 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
9877 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
9878 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
9879 ! Derivatives of virtual-bond vectors in theta
9881 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
9883 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
9884 ! Derivatives of SC vectors in theta
9888 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
9890 dxdv(k,ind1+1)=dxoijk
9893 !--- Calculate the derivatives in phi
9899 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
9905 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
9910 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
9912 dxdv(k+3,ind1+1)=dxoijk
9917 ! Derivatives in alpha and omega:
9920 ! dsci=dsc(itype(i))
9925 if(alphi.ne.alphi) alphi=100.0
9926 if(omegi.ne.omegi) omegi=-100.0
9931 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
9932 cosalphi=dcos(alphi)
9933 sinalphi=dsin(alphi)
9934 cosomegi=dcos(omegi)
9935 sinomegi=dsin(omegi)
9936 temp(1,1)=-dsci*sinalphi
9937 temp(2,1)= dsci*cosalphi*cosomegi
9938 temp(3,1)=-dsci*cosalphi*sinomegi
9940 temp(2,2)=-dsci*sinalphi*sinomegi
9941 temp(3,2)=-dsci*sinalphi*cosomegi
9942 theta2=pi-0.5D0*theta(i+1)
9946 !d print *,((temp(l,k),l=1,3),k=1,2)
9950 xxp= xp*cost2+yp*sint2
9951 yyp=-xp*sint2+yp*cost2
9954 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
9955 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
9959 dj=dj+prod(k,l,i-1)*xx(l)
9967 end subroutine cartder
9968 !-----------------------------------------------------------------------------
9970 !-----------------------------------------------------------------------------
9971 subroutine check_cartgrad
9972 ! Check the gradient of Cartesian coordinates in internal coordinates.
9973 ! implicit real*8 (a-h,o-z)
9974 ! include 'DIMENSIONS'
9975 ! include 'COMMON.IOUNITS'
9976 ! include 'COMMON.VAR'
9977 ! include 'COMMON.CHAIN'
9978 ! include 'COMMON.GEO'
9979 ! include 'COMMON.LOCAL'
9980 ! include 'COMMON.DERIV'
9981 real(kind=8),dimension(6,nres) :: temp
9982 real(kind=8),dimension(3) :: xx,gg
9984 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
9985 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
9987 ! Check the gradient of the virtual-bond and SC vectors in the internal
9993 write (iout,'(a)') '**************** dx/dalpha'
9997 alph(i)=alph(i)+aincr
9999 temp(k,i)=dc(k,nres+i)
10003 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
10004 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
10006 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
10007 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
10013 write (iout,'(a)') '**************** dx/domega'
10017 omeg(i)=omeg(i)+aincr
10019 temp(k,i)=dc(k,nres+i)
10023 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
10024 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
10025 (aincr*dabs(dxds(k+3,i))+aincr))
10027 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
10028 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
10034 write (iout,'(a)') '**************** dx/dtheta'
10038 theta(i)=theta(i)+aincr
10041 temp(k,j)=dc(k,nres+j)
10047 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
10049 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
10050 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
10051 (aincr*dabs(dxdv(k,ii))+aincr))
10053 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10054 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
10061 write (iout,'(a)') '***************** dx/dphi'
10064 phi(i)=phi(i)+aincr
10067 temp(k,j)=dc(k,nres+j)
10075 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
10076 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
10077 (aincr*dabs(dxdv(k+3,ii))+aincr))
10079 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10080 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
10083 phi(i)=phi(i)-aincr
10086 write (iout,'(a)') '****************** ddc/dtheta'
10089 theta(i+2)=thet+aincr
10100 gg(k)=(dc(k,j)-temp(k,j))/aincr
10101 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
10102 (aincr*dabs(dcdv(k,ii))+aincr))
10104 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10105 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
10115 write (iout,'(a)') '******************* ddc/dphi'
10118 phi(i+3)=phii+aincr
10129 gg(k)=(dc(k,j)-temp(k,j))/aincr
10130 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
10131 (aincr*dabs(dcdv(k+3,ii))+aincr))
10133 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10134 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
10145 end subroutine check_cartgrad
10146 !-----------------------------------------------------------------------------
10147 subroutine check_ecart
10148 ! Check the gradient of the energy in Cartesian coordinates.
10149 ! implicit real*8 (a-h,o-z)
10150 ! include 'DIMENSIONS'
10151 ! include 'COMMON.CHAIN'
10152 ! include 'COMMON.DERIV'
10153 ! include 'COMMON.IOUNITS'
10154 ! include 'COMMON.VAR'
10155 ! include 'COMMON.CONTACTS'
10157 !el integer :: icall
10158 !el common /srutu/ icall
10159 real(kind=8),dimension(6) :: ggg
10160 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
10161 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10162 real(kind=8),dimension(6,nres) :: grad_s
10163 real(kind=8),dimension(0:n_ene) :: energia,energia1
10164 integer :: uiparm(1)
10165 real(kind=8) :: urparm(1)
10167 integer :: nf,i,j,k
10168 real(kind=8) :: aincr,etot,etot1
10174 print '(a)','CG processor',me,' calling CHECK_CART.'
10177 call geom_to_var(nvar,x)
10178 call etotal(energia)
10180 !el call enerprint(energia)
10181 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
10184 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10188 grad_s(j,i)=gradc(j,i,icg)
10189 grad_s(j+3,i)=gradx(j,i,icg)
10193 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10198 ddx(j)=dc(j,i+nres)
10201 dc(j,i)=dc(j,i)+aincr
10203 c(j,k)=c(j,k)+aincr
10204 c(j,k+nres)=c(j,k+nres)+aincr
10206 call etotal(energia1)
10208 ggg(j)=(etot1-etot)/aincr
10211 c(j,k)=c(j,k)-aincr
10212 c(j,k+nres)=c(j,k+nres)-aincr
10216 c(j,i+nres)=c(j,i+nres)+aincr
10217 dc(j,i+nres)=dc(j,i+nres)+aincr
10218 call etotal(energia1)
10220 ggg(j+3)=(etot1-etot)/aincr
10222 dc(j,i+nres)=ddx(j)
10224 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
10225 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
10228 end subroutine check_ecart
10229 !-----------------------------------------------------------------------------
10230 subroutine check_ecartint
10231 ! Check the gradient of the energy in Cartesian coordinates.
10232 use io_base, only: intout
10233 ! implicit real*8 (a-h,o-z)
10234 ! include 'DIMENSIONS'
10235 ! include 'COMMON.CONTROL'
10236 ! include 'COMMON.CHAIN'
10237 ! include 'COMMON.DERIV'
10238 ! include 'COMMON.IOUNITS'
10239 ! include 'COMMON.VAR'
10240 ! include 'COMMON.CONTACTS'
10241 ! include 'COMMON.MD'
10242 ! include 'COMMON.LOCAL'
10243 ! include 'COMMON.SPLITELE'
10245 !el integer :: icall
10246 !el common /srutu/ icall
10247 real(kind=8),dimension(6) :: ggg,ggg1
10248 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
10249 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10250 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
10251 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
10252 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
10253 real(kind=8),dimension(0:n_ene) :: energia,energia1
10254 integer :: uiparm(1)
10255 real(kind=8) :: urparm(1)
10257 integer :: i,j,k,nf
10258 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
10266 ! call intcartderiv
10267 ! call checkintcartgrad
10270 write(iout,*) 'Calling CHECK_ECARTINT.'
10273 call geom_to_var(nvar,x)
10274 if (.not.split_ene) then
10275 call etotal(energia)
10277 !el call enerprint(energia)
10279 write (iout,*) "enter cartgrad"
10282 write (iout,*) "exit cartgrad"
10286 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10289 grad_s(j,0)=gcart(j,0)
10293 grad_s(j,i)=gcart(j,i)
10294 grad_s(j+3,i)=gxcart(j,i)
10298 !- split gradient check
10300 call etotal_long(energia)
10301 !el call enerprint(energia)
10303 write (iout,*) "enter cartgrad"
10306 write (iout,*) "exit cartgrad"
10309 write (iout,*) "longrange grad"
10311 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10312 (gxcart(j,i),j=1,3)
10315 grad_s(j,0)=gcart(j,0)
10319 grad_s(j,i)=gcart(j,i)
10320 grad_s(j+3,i)=gxcart(j,i)
10324 call etotal_short(energia)
10325 !el call enerprint(energia)
10327 write (iout,*) "enter cartgrad"
10330 write (iout,*) "exit cartgrad"
10333 write (iout,*) "shortrange grad"
10335 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10336 (gxcart(j,i),j=1,3)
10339 grad_s1(j,0)=gcart(j,0)
10343 grad_s1(j,i)=gcart(j,i)
10344 grad_s1(j+3,i)=gxcart(j,i)
10348 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10353 ddx(j)=dc(j,i+nres)
10355 dcnorm_safe(k)=dc_norm(k,i)
10356 dxnorm_safe(k)=dc_norm(k,i+nres)
10360 dc(j,i)=ddc(j)+aincr
10361 call chainbuild_cart
10363 ! Broadcast the order to compute internal coordinates to the slaves.
10364 ! if (nfgtasks.gt.1)
10365 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
10367 ! call int_from_cart1(.false.)
10368 if (.not.split_ene) then
10369 call etotal(energia1)
10373 call etotal_long(energia1)
10375 call etotal_short(energia1)
10377 ! write (iout,*) "etot11",etot11," etot12",etot12
10379 !- end split gradient
10380 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10381 dc(j,i)=ddc(j)-aincr
10382 call chainbuild_cart
10383 ! call int_from_cart1(.false.)
10384 if (.not.split_ene) then
10385 call etotal(energia1)
10387 ggg(j)=(etot1-etot2)/(2*aincr)
10390 call etotal_long(energia1)
10392 ggg(j)=(etot11-etot21)/(2*aincr)
10393 call etotal_short(energia1)
10395 ggg1(j)=(etot12-etot22)/(2*aincr)
10396 !- end split gradient
10397 ! write (iout,*) "etot21",etot21," etot22",etot22
10399 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10401 call chainbuild_cart
10404 dc(j,i+nres)=ddx(j)+aincr
10405 call chainbuild_cart
10406 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
10407 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
10408 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
10409 ! write (iout,*) "dxnormnorm",dsqrt(
10410 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
10411 ! write (iout,*) "dxnormnormsafe",dsqrt(
10412 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
10414 if (.not.split_ene) then
10415 call etotal(energia1)
10419 call etotal_long(energia1)
10421 call etotal_short(energia1)
10424 !- end split gradient
10425 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10426 dc(j,i+nres)=ddx(j)-aincr
10427 call chainbuild_cart
10428 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
10429 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
10430 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
10432 ! write (iout,*) "dxnormnorm",dsqrt(
10433 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
10434 ! write (iout,*) "dxnormnormsafe",dsqrt(
10435 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
10436 if (.not.split_ene) then
10437 call etotal(energia1)
10439 ggg(j+3)=(etot1-etot2)/(2*aincr)
10442 call etotal_long(energia1)
10444 ggg(j+3)=(etot11-etot21)/(2*aincr)
10445 call etotal_short(energia1)
10447 ggg1(j+3)=(etot12-etot22)/(2*aincr)
10448 !- end split gradient
10450 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10451 dc(j,i+nres)=ddx(j)
10452 call chainbuild_cart
10454 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10455 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
10456 if (split_ene) then
10457 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10458 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
10460 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10461 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
10462 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
10466 end subroutine check_ecartint
10467 !-----------------------------------------------------------------------------
10468 subroutine check_eint
10469 ! Check the gradient of energy in internal coordinates.
10470 ! implicit real*8 (a-h,o-z)
10471 ! include 'DIMENSIONS'
10472 ! include 'COMMON.CHAIN'
10473 ! include 'COMMON.DERIV'
10474 ! include 'COMMON.IOUNITS'
10475 ! include 'COMMON.VAR'
10476 ! include 'COMMON.GEO'
10478 !el integer :: icall
10479 !el common /srutu/ icall
10480 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
10481 integer :: uiparm(1)
10482 real(kind=8) :: urparm(1)
10483 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
10484 character(len=6) :: key
10487 real(kind=8) :: xi,aincr,etot,etot1,etot2
10490 print '(a)','Calling CHECK_INT.'
10494 call geom_to_var(nvar,x)
10495 call var_to_geom(nvar,x)
10499 call etotal(energia)
10501 !el call enerprint(energia)
10504 if (MyID.ne.BossID) then
10505 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
10513 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
10514 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
10515 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
10519 x(i)=xi-0.5D0*aincr
10520 call var_to_geom(nvar,x)
10522 call etotal(energia1)
10524 x(i)=xi+0.5D0*aincr
10525 call var_to_geom(nvar,x)
10527 call etotal(energia2)
10529 gg(i)=(etot2-etot1)/aincr
10530 write (iout,*) i,etot1,etot2
10533 write (iout,'(/2a)')' Variable Numerical Analytical',&
10536 if (i.le.nphi) then
10539 else if (i.le.nphi+ntheta) then
10542 else if (i.le.nphi+ntheta+nside) then
10546 ii=i-(nphi+ntheta+nside)
10549 write (iout,'(i3,a,i3,3(1pd16.6))') &
10550 i,key,ii,gg(i),gana(i),&
10551 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
10554 end subroutine check_eint
10555 !-----------------------------------------------------------------------------
10557 !-----------------------------------------------------------------------------
10558 subroutine Econstr_back
10559 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
10560 ! implicit real*8 (a-h,o-z)
10561 ! include 'DIMENSIONS'
10562 ! include 'COMMON.CONTROL'
10563 ! include 'COMMON.VAR'
10564 ! include 'COMMON.MD'
10567 ! include 'COMMON.LANGEVIN'
10569 ! include 'COMMON.LANGEVIN.lang0'
10571 ! include 'COMMON.CHAIN'
10572 ! include 'COMMON.DERIV'
10573 ! include 'COMMON.GEO'
10574 ! include 'COMMON.LOCAL'
10575 ! include 'COMMON.INTERACT'
10576 ! include 'COMMON.IOUNITS'
10577 ! include 'COMMON.NAMES'
10578 ! include 'COMMON.TIME1'
10579 integer :: i,j,ii,k
10580 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
10582 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
10583 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
10584 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
10591 duscdiff(j,i)=0.0d0
10592 duscdiffx(j,i)=0.0d0
10596 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
10598 ! Deviations from theta angles
10601 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
10602 dtheta_i=theta(j)-thetaref(j)
10603 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
10604 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
10606 utheta(i)=utheta_i/(ii-1)
10608 ! Deviations from gamma angles
10611 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
10612 dgamma_i=pinorm(phi(j)-phiref(j))
10613 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
10614 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
10615 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
10616 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
10618 ugamma(i)=ugamma_i/(ii-2)
10620 ! Deviations from local SC geometry
10623 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
10624 dxx=xxtab(j)-xxref(j)
10625 dyy=yytab(j)-yyref(j)
10626 dzz=zztab(j)-zzref(j)
10627 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
10629 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
10630 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
10632 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
10633 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
10635 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
10636 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
10639 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
10640 ! & xxref(j),yyref(j),zzref(j)
10642 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
10643 ! write (iout,*) i," uscdiff",uscdiff(i)
10645 ! Put together deviations from local geometry
10647 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
10648 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
10649 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
10650 ! & " uconst_back",uconst_back
10651 utheta(i)=dsqrt(utheta(i))
10652 ugamma(i)=dsqrt(ugamma(i))
10653 uscdiff(i)=dsqrt(uscdiff(i))
10656 end subroutine Econstr_back
10657 !-----------------------------------------------------------------------------
10658 ! energy_p_new-sep_barrier.F
10659 !-----------------------------------------------------------------------------
10660 real(kind=8) function sscale(r)
10661 ! include "COMMON.SPLITELE"
10662 real(kind=8) :: r,gamm
10663 if(r.lt.r_cut-rlamb) then
10665 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10666 gamm=(r-(r_cut-rlamb))/rlamb
10667 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
10672 end function sscale
10673 !-----------------------------------------------------------------------------
10674 subroutine elj_long(evdw)
10676 ! This subroutine calculates the interaction energy of nonbonded side chains
10677 ! assuming the LJ potential of interaction.
10679 ! implicit real*8 (a-h,o-z)
10680 ! include 'DIMENSIONS'
10681 ! include 'COMMON.GEO'
10682 ! include 'COMMON.VAR'
10683 ! include 'COMMON.LOCAL'
10684 ! include 'COMMON.CHAIN'
10685 ! include 'COMMON.DERIV'
10686 ! include 'COMMON.INTERACT'
10687 ! include 'COMMON.TORSION'
10688 ! include 'COMMON.SBRIDGE'
10689 ! include 'COMMON.NAMES'
10690 ! include 'COMMON.IOUNITS'
10691 ! include 'COMMON.CONTACTS'
10692 real(kind=8),parameter :: accur=1.0d-10
10693 real(kind=8),dimension(3) :: gg
10694 !el local variables
10695 integer :: i,iint,j,k,itypi,itypi1,itypj
10696 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
10697 real(kind=8) :: e1,e2,evdwij,evdw
10698 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
10700 do i=iatsc_s,iatsc_e
10702 if (itypi.eq.ntyp1) cycle
10708 ! Calculate SC interaction energy.
10710 do iint=1,nint_gr(i)
10711 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
10712 !d & 'iend=',iend(i,iint)
10713 do j=istart(i,iint),iend(i,iint)
10715 if (itypj.eq.ntyp1) cycle
10719 rij=xj*xj+yj*yj+zj*zj
10720 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
10721 if (sss.lt.1.0d0) then
10723 eps0ij=eps(itypi,itypj)
10725 e1=fac*fac*aa(itypi,itypj)
10726 e2=fac*bb(itypi,itypj)
10728 evdw=evdw+(1.0d0-sss)*evdwij
10730 ! Calculate the components of the gradient in DC and X
10732 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
10737 gvdwx(k,i)=gvdwx(k,i)-gg(k)
10738 gvdwx(k,j)=gvdwx(k,j)+gg(k)
10739 gvdwc(k,i)=gvdwc(k,i)-gg(k)
10740 gvdwc(k,j)=gvdwc(k,j)+gg(k)
10748 gvdwc(j,i)=expon*gvdwc(j,i)
10749 gvdwx(j,i)=expon*gvdwx(j,i)
10752 !******************************************************************************
10756 ! To save time, the factor of EXPON has been extracted from ALL components
10757 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
10760 !******************************************************************************
10762 end subroutine elj_long
10763 !-----------------------------------------------------------------------------
10764 subroutine elj_short(evdw)
10766 ! This subroutine calculates the interaction energy of nonbonded side chains
10767 ! assuming the LJ potential of interaction.
10769 ! implicit real*8 (a-h,o-z)
10770 ! include 'DIMENSIONS'
10771 ! include 'COMMON.GEO'
10772 ! include 'COMMON.VAR'
10773 ! include 'COMMON.LOCAL'
10774 ! include 'COMMON.CHAIN'
10775 ! include 'COMMON.DERIV'
10776 ! include 'COMMON.INTERACT'
10777 ! include 'COMMON.TORSION'
10778 ! include 'COMMON.SBRIDGE'
10779 ! include 'COMMON.NAMES'
10780 ! include 'COMMON.IOUNITS'
10781 ! include 'COMMON.CONTACTS'
10782 real(kind=8),parameter :: accur=1.0d-10
10783 real(kind=8),dimension(3) :: gg
10784 !el local variables
10785 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
10786 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
10787 real(kind=8) :: e1,e2,evdwij,evdw
10788 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
10790 do i=iatsc_s,iatsc_e
10792 if (itypi.eq.ntyp1) cycle
10800 ! Calculate SC interaction energy.
10802 do iint=1,nint_gr(i)
10803 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
10804 !d & 'iend=',iend(i,iint)
10805 do j=istart(i,iint),iend(i,iint)
10807 if (itypj.eq.ntyp1) cycle
10811 ! Change 12/1/95 to calculate four-body interactions
10812 rij=xj*xj+yj*yj+zj*zj
10813 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
10814 if (sss.gt.0.0d0) then
10816 eps0ij=eps(itypi,itypj)
10818 e1=fac*fac*aa(itypi,itypj)
10819 e2=fac*bb(itypi,itypj)
10821 evdw=evdw+sss*evdwij
10823 ! Calculate the components of the gradient in DC and X
10825 fac=-rrij*(e1+evdwij)*sss
10830 gvdwx(k,i)=gvdwx(k,i)-gg(k)
10831 gvdwx(k,j)=gvdwx(k,j)+gg(k)
10832 gvdwc(k,i)=gvdwc(k,i)-gg(k)
10833 gvdwc(k,j)=gvdwc(k,j)+gg(k)
10841 gvdwc(j,i)=expon*gvdwc(j,i)
10842 gvdwx(j,i)=expon*gvdwx(j,i)
10845 !******************************************************************************
10849 ! To save time, the factor of EXPON has been extracted from ALL components
10850 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
10853 !******************************************************************************
10855 end subroutine elj_short
10856 !-----------------------------------------------------------------------------
10857 subroutine eljk_long(evdw)
10859 ! This subroutine calculates the interaction energy of nonbonded side chains
10860 ! assuming the LJK potential of interaction.
10862 ! implicit real*8 (a-h,o-z)
10863 ! include 'DIMENSIONS'
10864 ! include 'COMMON.GEO'
10865 ! include 'COMMON.VAR'
10866 ! include 'COMMON.LOCAL'
10867 ! include 'COMMON.CHAIN'
10868 ! include 'COMMON.DERIV'
10869 ! include 'COMMON.INTERACT'
10870 ! include 'COMMON.IOUNITS'
10871 ! include 'COMMON.NAMES'
10872 real(kind=8),dimension(3) :: gg
10874 !el local variables
10875 integer :: i,iint,j,k,itypi,itypi1,itypj
10876 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
10877 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
10878 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
10880 do i=iatsc_s,iatsc_e
10882 if (itypi.eq.ntyp1) cycle
10888 ! Calculate SC interaction energy.
10890 do iint=1,nint_gr(i)
10891 do j=istart(i,iint),iend(i,iint)
10893 if (itypj.eq.ntyp1) cycle
10897 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
10898 fac_augm=rrij**expon
10899 e_augm=augm(itypi,itypj)*fac_augm
10900 r_inv_ij=dsqrt(rrij)
10902 sss=sscale(rij/sigma(itypi,itypj))
10903 if (sss.lt.1.0d0) then
10904 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
10905 fac=r_shift_inv**expon
10906 e1=fac*fac*aa(itypi,itypj)
10907 e2=fac*bb(itypi,itypj)
10908 evdwij=e_augm+e1+e2
10909 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
10910 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
10911 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
10912 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
10913 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
10914 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
10915 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
10916 evdw=evdw+(1.0d0-sss)*evdwij
10918 ! Calculate the components of the gradient in DC and X
10920 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
10921 fac=fac*(1.0d0-sss)
10926 gvdwx(k,i)=gvdwx(k,i)-gg(k)
10927 gvdwx(k,j)=gvdwx(k,j)+gg(k)
10928 gvdwc(k,i)=gvdwc(k,i)-gg(k)
10929 gvdwc(k,j)=gvdwc(k,j)+gg(k)
10937 gvdwc(j,i)=expon*gvdwc(j,i)
10938 gvdwx(j,i)=expon*gvdwx(j,i)
10942 end subroutine eljk_long
10943 !-----------------------------------------------------------------------------
10944 subroutine eljk_short(evdw)
10946 ! This subroutine calculates the interaction energy of nonbonded side chains
10947 ! assuming the LJK potential of interaction.
10949 ! implicit real*8 (a-h,o-z)
10950 ! include 'DIMENSIONS'
10951 ! include 'COMMON.GEO'
10952 ! include 'COMMON.VAR'
10953 ! include 'COMMON.LOCAL'
10954 ! include 'COMMON.CHAIN'
10955 ! include 'COMMON.DERIV'
10956 ! include 'COMMON.INTERACT'
10957 ! include 'COMMON.IOUNITS'
10958 ! include 'COMMON.NAMES'
10959 real(kind=8),dimension(3) :: gg
10961 !el local variables
10962 integer :: i,iint,j,k,itypi,itypi1,itypj
10963 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
10964 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
10965 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
10967 do i=iatsc_s,iatsc_e
10969 if (itypi.eq.ntyp1) cycle
10975 ! Calculate SC interaction energy.
10977 do iint=1,nint_gr(i)
10978 do j=istart(i,iint),iend(i,iint)
10980 if (itypj.eq.ntyp1) cycle
10984 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
10985 fac_augm=rrij**expon
10986 e_augm=augm(itypi,itypj)*fac_augm
10987 r_inv_ij=dsqrt(rrij)
10989 sss=sscale(rij/sigma(itypi,itypj))
10990 if (sss.gt.0.0d0) then
10991 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
10992 fac=r_shift_inv**expon
10993 e1=fac*fac*aa(itypi,itypj)
10994 e2=fac*bb(itypi,itypj)
10995 evdwij=e_augm+e1+e2
10996 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
10997 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
10998 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
10999 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
11000 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
11001 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
11002 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
11003 evdw=evdw+sss*evdwij
11005 ! Calculate the components of the gradient in DC and X
11007 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
11013 gvdwx(k,i)=gvdwx(k,i)-gg(k)
11014 gvdwx(k,j)=gvdwx(k,j)+gg(k)
11015 gvdwc(k,i)=gvdwc(k,i)-gg(k)
11016 gvdwc(k,j)=gvdwc(k,j)+gg(k)
11024 gvdwc(j,i)=expon*gvdwc(j,i)
11025 gvdwx(j,i)=expon*gvdwx(j,i)
11029 end subroutine eljk_short
11030 !-----------------------------------------------------------------------------
11031 subroutine ebp_long(evdw)
11033 ! This subroutine calculates the interaction energy of nonbonded side chains
11034 ! assuming the Berne-Pechukas potential of interaction.
11037 ! implicit real*8 (a-h,o-z)
11038 ! include 'DIMENSIONS'
11039 ! include 'COMMON.GEO'
11040 ! include 'COMMON.VAR'
11041 ! include 'COMMON.LOCAL'
11042 ! include 'COMMON.CHAIN'
11043 ! include 'COMMON.DERIV'
11044 ! include 'COMMON.NAMES'
11045 ! include 'COMMON.INTERACT'
11046 ! include 'COMMON.IOUNITS'
11047 ! include 'COMMON.CALC'
11049 !el integer :: icall
11050 !el common /srutu/ icall
11051 ! double precision rrsave(maxdim)
11053 !el local variables
11054 integer :: iint,itypi,itypi1,itypj
11055 real(kind=8) :: rrij,xi,yi,zi,fac
11056 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
11058 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
11060 ! if (icall.eq.0) then
11066 do i=iatsc_s,iatsc_e
11068 if (itypi.eq.ntyp1) cycle
11073 dxi=dc_norm(1,nres+i)
11074 dyi=dc_norm(2,nres+i)
11075 dzi=dc_norm(3,nres+i)
11076 ! dsci_inv=dsc_inv(itypi)
11077 dsci_inv=vbld_inv(i+nres)
11079 ! Calculate SC interaction energy.
11081 do iint=1,nint_gr(i)
11082 do j=istart(i,iint),iend(i,iint)
11085 if (itypj.eq.ntyp1) cycle
11086 ! dscj_inv=dsc_inv(itypj)
11087 dscj_inv=vbld_inv(j+nres)
11088 chi1=chi(itypi,itypj)
11089 chi2=chi(itypj,itypi)
11096 alf12=0.5D0*(alf1+alf2)
11100 dxj=dc_norm(1,nres+j)
11101 dyj=dc_norm(2,nres+j)
11102 dzj=dc_norm(3,nres+j)
11103 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11105 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11107 if (sss.lt.1.0d0) then
11109 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
11111 ! Calculate whole angle-dependent part of epsilon and contributions
11112 ! to its derivatives
11113 fac=(rrij*sigsq)**expon2
11114 e1=fac*fac*aa(itypi,itypj)
11115 e2=fac*bb(itypi,itypj)
11116 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11117 eps2der=evdwij*eps3rt
11118 eps3der=evdwij*eps2rt
11119 evdwij=evdwij*eps2rt*eps3rt
11120 evdw=evdw+evdwij*(1.0d0-sss)
11122 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11123 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11124 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
11125 !d & restyp(itypi),i,restyp(itypj),j,
11126 !d & epsi,sigm,chi1,chi2,chip1,chip2,
11127 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
11128 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
11131 ! Calculate gradient components.
11132 e1=e1*eps1*eps2rt**2*eps3rt**2
11133 fac=-expon*(e1+evdwij)
11136 ! Calculate radial part of the gradient
11140 ! Calculate the angular part of the gradient and sum add the contributions
11141 ! to the appropriate components of the Cartesian gradient.
11142 call sc_grad_scale(1.0d0-sss)
11149 end subroutine ebp_long
11150 !-----------------------------------------------------------------------------
11151 subroutine ebp_short(evdw)
11153 ! This subroutine calculates the interaction energy of nonbonded side chains
11154 ! assuming the Berne-Pechukas potential of interaction.
11157 ! implicit real*8 (a-h,o-z)
11158 ! include 'DIMENSIONS'
11159 ! include 'COMMON.GEO'
11160 ! include 'COMMON.VAR'
11161 ! include 'COMMON.LOCAL'
11162 ! include 'COMMON.CHAIN'
11163 ! include 'COMMON.DERIV'
11164 ! include 'COMMON.NAMES'
11165 ! include 'COMMON.INTERACT'
11166 ! include 'COMMON.IOUNITS'
11167 ! include 'COMMON.CALC'
11169 !el integer :: icall
11170 !el common /srutu/ icall
11171 ! double precision rrsave(maxdim)
11173 !el local variables
11174 integer :: iint,itypi,itypi1,itypj
11175 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
11176 real(kind=8) :: sss,e1,e2,evdw
11178 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
11180 ! if (icall.eq.0) then
11186 do i=iatsc_s,iatsc_e
11188 if (itypi.eq.ntyp1) cycle
11193 dxi=dc_norm(1,nres+i)
11194 dyi=dc_norm(2,nres+i)
11195 dzi=dc_norm(3,nres+i)
11196 ! dsci_inv=dsc_inv(itypi)
11197 dsci_inv=vbld_inv(i+nres)
11199 ! Calculate SC interaction energy.
11201 do iint=1,nint_gr(i)
11202 do j=istart(i,iint),iend(i,iint)
11205 if (itypj.eq.ntyp1) cycle
11206 ! dscj_inv=dsc_inv(itypj)
11207 dscj_inv=vbld_inv(j+nres)
11208 chi1=chi(itypi,itypj)
11209 chi2=chi(itypj,itypi)
11216 alf12=0.5D0*(alf1+alf2)
11220 dxj=dc_norm(1,nres+j)
11221 dyj=dc_norm(2,nres+j)
11222 dzj=dc_norm(3,nres+j)
11223 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11225 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11227 if (sss.gt.0.0d0) then
11229 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
11231 ! Calculate whole angle-dependent part of epsilon and contributions
11232 ! to its derivatives
11233 fac=(rrij*sigsq)**expon2
11234 e1=fac*fac*aa(itypi,itypj)
11235 e2=fac*bb(itypi,itypj)
11236 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11237 eps2der=evdwij*eps3rt
11238 eps3der=evdwij*eps2rt
11239 evdwij=evdwij*eps2rt*eps3rt
11240 evdw=evdw+evdwij*sss
11242 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11243 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11244 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
11245 !d & restyp(itypi),i,restyp(itypj),j,
11246 !d & epsi,sigm,chi1,chi2,chip1,chip2,
11247 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
11248 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
11251 ! Calculate gradient components.
11252 e1=e1*eps1*eps2rt**2*eps3rt**2
11253 fac=-expon*(e1+evdwij)
11256 ! Calculate radial part of the gradient
11260 ! Calculate the angular part of the gradient and sum add the contributions
11261 ! to the appropriate components of the Cartesian gradient.
11262 call sc_grad_scale(sss)
11269 end subroutine ebp_short
11270 !-----------------------------------------------------------------------------
11271 subroutine egb_long(evdw)
11273 ! This subroutine calculates the interaction energy of nonbonded side chains
11274 ! assuming the Gay-Berne potential of interaction.
11277 ! implicit real*8 (a-h,o-z)
11278 ! include 'DIMENSIONS'
11279 ! include 'COMMON.GEO'
11280 ! include 'COMMON.VAR'
11281 ! include 'COMMON.LOCAL'
11282 ! include 'COMMON.CHAIN'
11283 ! include 'COMMON.DERIV'
11284 ! include 'COMMON.NAMES'
11285 ! include 'COMMON.INTERACT'
11286 ! include 'COMMON.IOUNITS'
11287 ! include 'COMMON.CALC'
11288 ! include 'COMMON.CONTROL'
11290 !el local variables
11291 integer :: iint,itypi,itypi1,itypj
11292 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
11293 real(kind=8) :: sss,e1,e2,evdw
11295 !cccc energy_dec=.false.
11296 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11299 ! if (icall.eq.0) lprn=.false.
11301 do i=iatsc_s,iatsc_e
11303 if (itypi.eq.ntyp1) cycle
11308 dxi=dc_norm(1,nres+i)
11309 dyi=dc_norm(2,nres+i)
11310 dzi=dc_norm(3,nres+i)
11311 ! dsci_inv=dsc_inv(itypi)
11312 dsci_inv=vbld_inv(i+nres)
11313 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
11314 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
11316 ! Calculate SC interaction energy.
11318 do iint=1,nint_gr(i)
11319 do j=istart(i,iint),iend(i,iint)
11322 if (itypj.eq.ntyp1) cycle
11323 ! dscj_inv=dsc_inv(itypj)
11324 dscj_inv=vbld_inv(j+nres)
11325 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
11326 ! & 1.0d0/vbld(j+nres)
11327 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
11328 sig0ij=sigma(itypi,itypj)
11329 chi1=chi(itypi,itypj)
11330 chi2=chi(itypj,itypi)
11337 alf12=0.5D0*(alf1+alf2)
11341 dxj=dc_norm(1,nres+j)
11342 dyj=dc_norm(2,nres+j)
11343 dzj=dc_norm(3,nres+j)
11344 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11346 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11348 if (sss.lt.1.0d0) then
11350 ! Calculate angle-dependent terms of energy and contributions to their
11354 sig=sig0ij*dsqrt(sigsq)
11355 rij_shift=1.0D0/rij-sig+sig0ij
11356 ! for diagnostics; uncomment
11357 ! rij_shift=1.2*sig0ij
11358 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11359 if (rij_shift.le.0.0D0) then
11361 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
11362 !d & restyp(itypi),i,restyp(itypj),j,
11363 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
11367 !---------------------------------------------------------------
11368 rij_shift=1.0D0/rij_shift
11369 fac=rij_shift**expon
11370 e1=fac*fac*aa(itypi,itypj)
11371 e2=fac*bb(itypi,itypj)
11372 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11373 eps2der=evdwij*eps3rt
11374 eps3der=evdwij*eps2rt
11375 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
11376 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
11377 evdwij=evdwij*eps2rt*eps3rt
11378 evdw=evdw+evdwij*(1.0d0-sss)
11380 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11381 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11382 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11383 restyp(itypi),i,restyp(itypj),j,&
11384 epsi,sigm,chi1,chi2,chip1,chip2,&
11385 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
11386 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11390 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
11392 ! if (energy_dec) write (iout,*) &
11393 ! 'evdw',i,j,evdwij,"egb_long"
11395 ! Calculate gradient components.
11396 e1=e1*eps1*eps2rt**2*eps3rt**2
11397 fac=-expon*(e1+evdwij)*rij_shift
11401 ! Calculate the radial part of the gradient
11405 ! Calculate angular part of the gradient.
11406 call sc_grad_scale(1.0d0-sss)
11411 ! write (iout,*) "Number of loop steps in EGB:",ind
11412 !ccc energy_dec=.false.
11414 end subroutine egb_long
11415 !-----------------------------------------------------------------------------
11416 subroutine egb_short(evdw)
11418 ! This subroutine calculates the interaction energy of nonbonded side chains
11419 ! assuming the Gay-Berne potential of interaction.
11422 ! implicit real*8 (a-h,o-z)
11423 ! include 'DIMENSIONS'
11424 ! include 'COMMON.GEO'
11425 ! include 'COMMON.VAR'
11426 ! include 'COMMON.LOCAL'
11427 ! include 'COMMON.CHAIN'
11428 ! include 'COMMON.DERIV'
11429 ! include 'COMMON.NAMES'
11430 ! include 'COMMON.INTERACT'
11431 ! include 'COMMON.IOUNITS'
11432 ! include 'COMMON.CALC'
11433 ! include 'COMMON.CONTROL'
11435 !el local variables
11436 integer :: iint,itypi,itypi1,itypj
11437 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
11438 real(kind=8) :: sss,e1,e2,evdw,rij_shift
11440 !cccc energy_dec=.false.
11441 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11444 ! if (icall.eq.0) lprn=.false.
11446 do i=iatsc_s,iatsc_e
11448 if (itypi.eq.ntyp1) cycle
11453 dxi=dc_norm(1,nres+i)
11454 dyi=dc_norm(2,nres+i)
11455 dzi=dc_norm(3,nres+i)
11456 ! dsci_inv=dsc_inv(itypi)
11457 dsci_inv=vbld_inv(i+nres)
11458 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
11459 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
11461 ! Calculate SC interaction energy.
11463 do iint=1,nint_gr(i)
11464 do j=istart(i,iint),iend(i,iint)
11467 if (itypj.eq.ntyp1) cycle
11468 ! dscj_inv=dsc_inv(itypj)
11469 dscj_inv=vbld_inv(j+nres)
11470 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
11471 ! & 1.0d0/vbld(j+nres)
11472 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
11473 sig0ij=sigma(itypi,itypj)
11474 chi1=chi(itypi,itypj)
11475 chi2=chi(itypj,itypi)
11482 alf12=0.5D0*(alf1+alf2)
11486 dxj=dc_norm(1,nres+j)
11487 dyj=dc_norm(2,nres+j)
11488 dzj=dc_norm(3,nres+j)
11489 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11491 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11493 if (sss.gt.0.0d0) then
11495 ! Calculate angle-dependent terms of energy and contributions to their
11499 sig=sig0ij*dsqrt(sigsq)
11500 rij_shift=1.0D0/rij-sig+sig0ij
11501 ! for diagnostics; uncomment
11502 ! rij_shift=1.2*sig0ij
11503 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11504 if (rij_shift.le.0.0D0) then
11506 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
11507 !d & restyp(itypi),i,restyp(itypj),j,
11508 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
11512 !---------------------------------------------------------------
11513 rij_shift=1.0D0/rij_shift
11514 fac=rij_shift**expon
11515 e1=fac*fac*aa(itypi,itypj)
11516 e2=fac*bb(itypi,itypj)
11517 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11518 eps2der=evdwij*eps3rt
11519 eps3der=evdwij*eps2rt
11520 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
11521 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
11522 evdwij=evdwij*eps2rt*eps3rt
11523 evdw=evdw+evdwij*sss
11525 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11526 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11527 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11528 restyp(itypi),i,restyp(itypj),j,&
11529 epsi,sigm,chi1,chi2,chip1,chip2,&
11530 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
11531 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11535 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
11537 ! if (energy_dec) write (iout,*) &
11538 ! 'evdw',i,j,evdwij,"egb_short"
11540 ! Calculate gradient components.
11541 e1=e1*eps1*eps2rt**2*eps3rt**2
11542 fac=-expon*(e1+evdwij)*rij_shift
11546 ! Calculate the radial part of the gradient
11550 ! Calculate angular part of the gradient.
11551 call sc_grad_scale(sss)
11556 ! write (iout,*) "Number of loop steps in EGB:",ind
11557 !ccc energy_dec=.false.
11559 end subroutine egb_short
11560 !-----------------------------------------------------------------------------
11561 subroutine egbv_long(evdw)
11563 ! This subroutine calculates the interaction energy of nonbonded side chains
11564 ! assuming the Gay-Berne-Vorobjev potential of interaction.
11567 ! implicit real*8 (a-h,o-z)
11568 ! include 'DIMENSIONS'
11569 ! include 'COMMON.GEO'
11570 ! include 'COMMON.VAR'
11571 ! include 'COMMON.LOCAL'
11572 ! include 'COMMON.CHAIN'
11573 ! include 'COMMON.DERIV'
11574 ! include 'COMMON.NAMES'
11575 ! include 'COMMON.INTERACT'
11576 ! include 'COMMON.IOUNITS'
11577 ! include 'COMMON.CALC'
11579 !el integer :: icall
11580 !el common /srutu/ icall
11582 !el local variables
11583 integer :: iint,itypi,itypi1,itypj
11584 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
11585 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
11587 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11590 ! if (icall.eq.0) lprn=.true.
11592 do i=iatsc_s,iatsc_e
11594 if (itypi.eq.ntyp1) cycle
11599 dxi=dc_norm(1,nres+i)
11600 dyi=dc_norm(2,nres+i)
11601 dzi=dc_norm(3,nres+i)
11602 ! dsci_inv=dsc_inv(itypi)
11603 dsci_inv=vbld_inv(i+nres)
11605 ! Calculate SC interaction energy.
11607 do iint=1,nint_gr(i)
11608 do j=istart(i,iint),iend(i,iint)
11611 if (itypj.eq.ntyp1) cycle
11612 ! dscj_inv=dsc_inv(itypj)
11613 dscj_inv=vbld_inv(j+nres)
11614 sig0ij=sigma(itypi,itypj)
11615 r0ij=r0(itypi,itypj)
11616 chi1=chi(itypi,itypj)
11617 chi2=chi(itypj,itypi)
11624 alf12=0.5D0*(alf1+alf2)
11628 dxj=dc_norm(1,nres+j)
11629 dyj=dc_norm(2,nres+j)
11630 dzj=dc_norm(3,nres+j)
11631 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11634 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11636 if (sss.lt.1.0d0) then
11638 ! Calculate angle-dependent terms of energy and contributions to their
11642 sig=sig0ij*dsqrt(sigsq)
11643 rij_shift=1.0D0/rij-sig+r0ij
11644 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11645 if (rij_shift.le.0.0D0) then
11650 !---------------------------------------------------------------
11651 rij_shift=1.0D0/rij_shift
11652 fac=rij_shift**expon
11653 e1=fac*fac*aa(itypi,itypj)
11654 e2=fac*bb(itypi,itypj)
11655 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11656 eps2der=evdwij*eps3rt
11657 eps3der=evdwij*eps2rt
11658 fac_augm=rrij**expon
11659 e_augm=augm(itypi,itypj)*fac_augm
11660 evdwij=evdwij*eps2rt*eps3rt
11661 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
11663 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11664 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11665 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11666 restyp(itypi),i,restyp(itypj),j,&
11667 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
11668 chi1,chi2,chip1,chip2,&
11669 eps1,eps2rt**2,eps3rt**2,&
11670 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11673 ! Calculate gradient components.
11674 e1=e1*eps1*eps2rt**2*eps3rt**2
11675 fac=-expon*(e1+evdwij)*rij_shift
11677 fac=rij*fac-2*expon*rrij*e_augm
11678 ! Calculate the radial part of the gradient
11682 ! Calculate angular part of the gradient.
11683 call sc_grad_scale(1.0d0-sss)
11688 end subroutine egbv_long
11689 !-----------------------------------------------------------------------------
11690 subroutine egbv_short(evdw)
11692 ! This subroutine calculates the interaction energy of nonbonded side chains
11693 ! assuming the Gay-Berne-Vorobjev potential of interaction.
11696 ! implicit real*8 (a-h,o-z)
11697 ! include 'DIMENSIONS'
11698 ! include 'COMMON.GEO'
11699 ! include 'COMMON.VAR'
11700 ! include 'COMMON.LOCAL'
11701 ! include 'COMMON.CHAIN'
11702 ! include 'COMMON.DERIV'
11703 ! include 'COMMON.NAMES'
11704 ! include 'COMMON.INTERACT'
11705 ! include 'COMMON.IOUNITS'
11706 ! include 'COMMON.CALC'
11708 !el integer :: icall
11709 !el common /srutu/ icall
11711 !el local variables
11712 integer :: iint,itypi,itypi1,itypj
11713 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
11714 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
11716 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11719 ! if (icall.eq.0) lprn=.true.
11721 do i=iatsc_s,iatsc_e
11723 if (itypi.eq.ntyp1) cycle
11728 dxi=dc_norm(1,nres+i)
11729 dyi=dc_norm(2,nres+i)
11730 dzi=dc_norm(3,nres+i)
11731 ! dsci_inv=dsc_inv(itypi)
11732 dsci_inv=vbld_inv(i+nres)
11734 ! Calculate SC interaction energy.
11736 do iint=1,nint_gr(i)
11737 do j=istart(i,iint),iend(i,iint)
11740 if (itypj.eq.ntyp1) cycle
11741 ! dscj_inv=dsc_inv(itypj)
11742 dscj_inv=vbld_inv(j+nres)
11743 sig0ij=sigma(itypi,itypj)
11744 r0ij=r0(itypi,itypj)
11745 chi1=chi(itypi,itypj)
11746 chi2=chi(itypj,itypi)
11753 alf12=0.5D0*(alf1+alf2)
11757 dxj=dc_norm(1,nres+j)
11758 dyj=dc_norm(2,nres+j)
11759 dzj=dc_norm(3,nres+j)
11760 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11763 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11765 if (sss.gt.0.0d0) then
11767 ! Calculate angle-dependent terms of energy and contributions to their
11771 sig=sig0ij*dsqrt(sigsq)
11772 rij_shift=1.0D0/rij-sig+r0ij
11773 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11774 if (rij_shift.le.0.0D0) then
11779 !---------------------------------------------------------------
11780 rij_shift=1.0D0/rij_shift
11781 fac=rij_shift**expon
11782 e1=fac*fac*aa(itypi,itypj)
11783 e2=fac*bb(itypi,itypj)
11784 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11785 eps2der=evdwij*eps3rt
11786 eps3der=evdwij*eps2rt
11787 fac_augm=rrij**expon
11788 e_augm=augm(itypi,itypj)*fac_augm
11789 evdwij=evdwij*eps2rt*eps3rt
11790 evdw=evdw+(evdwij+e_augm)*sss
11792 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11793 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11794 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11795 restyp(itypi),i,restyp(itypj),j,&
11796 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
11797 chi1,chi2,chip1,chip2,&
11798 eps1,eps2rt**2,eps3rt**2,&
11799 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11802 ! Calculate gradient components.
11803 e1=e1*eps1*eps2rt**2*eps3rt**2
11804 fac=-expon*(e1+evdwij)*rij_shift
11806 fac=rij*fac-2*expon*rrij*e_augm
11807 ! Calculate the radial part of the gradient
11811 ! Calculate angular part of the gradient.
11812 call sc_grad_scale(sss)
11817 end subroutine egbv_short
11818 !-----------------------------------------------------------------------------
11819 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
11821 ! This subroutine calculates the average interaction energy and its gradient
11822 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
11823 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
11824 ! The potential depends both on the distance of peptide-group centers and on
11825 ! the orientation of the CA-CA virtual bonds.
11827 ! implicit real*8 (a-h,o-z)
11833 ! include 'DIMENSIONS'
11834 ! include 'COMMON.CONTROL'
11835 ! include 'COMMON.SETUP'
11836 ! include 'COMMON.IOUNITS'
11837 ! include 'COMMON.GEO'
11838 ! include 'COMMON.VAR'
11839 ! include 'COMMON.LOCAL'
11840 ! include 'COMMON.CHAIN'
11841 ! include 'COMMON.DERIV'
11842 ! include 'COMMON.INTERACT'
11843 ! include 'COMMON.CONTACTS'
11844 ! include 'COMMON.TORSION'
11845 ! include 'COMMON.VECTORS'
11846 ! include 'COMMON.FFIELD'
11847 ! include 'COMMON.TIME1'
11848 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
11849 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
11850 real(kind=8),dimension(2,2) :: acipa !el,a_temp
11851 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
11852 real(kind=8),dimension(4) :: muij
11853 !el integer :: num_conti,j1,j2
11854 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
11855 !el dz_normi,xmedi,ymedi,zmedi
11856 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
11857 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
11858 !el num_conti,j1,j2
11859 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
11861 real(kind=8) :: scal_el=1.0d0
11863 real(kind=8) :: scal_el=0.5d0
11866 ! 13-go grudnia roku pamietnego...
11867 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
11868 0.0d0,1.0d0,0.0d0,&
11869 0.0d0,0.0d0,1.0d0/),shape(unmat))
11870 !el local variables
11872 real(kind=8) :: fac
11873 real(kind=8) :: dxj,dyj,dzj
11874 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
11876 ! allocate(num_cont_hb(nres)) !(maxres)
11877 !d write(iout,*) 'In EELEC'
11879 !d write(iout,*) 'Type',i
11880 !d write(iout,*) 'B1',B1(:,i)
11881 !d write(iout,*) 'B2',B2(:,i)
11882 !d write(iout,*) 'CC',CC(:,:,i)
11883 !d write(iout,*) 'DD',DD(:,:,i)
11884 !d write(iout,*) 'EE',EE(:,:,i)
11886 !d call check_vecgrad
11888 if (icheckgrad.eq.1) then
11890 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
11892 dc_norm(k,i)=dc(k,i)*fac
11894 ! write (iout,*) 'i',i,' fac',fac
11897 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
11898 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
11899 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
11900 ! call vec_and_deriv
11906 time_mat=time_mat+MPI_Wtime()-time01
11910 !d write (iout,*) 'i=',i
11912 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
11915 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
11916 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
11929 !d print '(a)','Enter EELEC'
11930 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
11931 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
11932 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
11934 gel_loc_loc(i)=0.0d0
11939 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
11941 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
11943 do i=iturn3_start,iturn3_end
11944 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1 &
11945 .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
11949 dx_normi=dc_norm(1,i)
11950 dy_normi=dc_norm(2,i)
11951 dz_normi=dc_norm(3,i)
11952 xmedi=c(1,i)+0.5d0*dxi
11953 ymedi=c(2,i)+0.5d0*dyi
11954 zmedi=c(3,i)+0.5d0*dzi
11956 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
11957 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
11958 num_cont_hb(i)=num_conti
11960 do i=iturn4_start,iturn4_end
11961 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
11962 .or. itype(i+3).eq.ntyp1 &
11963 .or. itype(i+4).eq.ntyp1) cycle
11967 dx_normi=dc_norm(1,i)
11968 dy_normi=dc_norm(2,i)
11969 dz_normi=dc_norm(3,i)
11970 xmedi=c(1,i)+0.5d0*dxi
11971 ymedi=c(2,i)+0.5d0*dyi
11972 zmedi=c(3,i)+0.5d0*dzi
11973 num_conti=num_cont_hb(i)
11974 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
11975 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
11976 call eturn4(i,eello_turn4)
11977 num_cont_hb(i)=num_conti
11980 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
11982 do i=iatel_s,iatel_e
11983 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
11987 dx_normi=dc_norm(1,i)
11988 dy_normi=dc_norm(2,i)
11989 dz_normi=dc_norm(3,i)
11990 xmedi=c(1,i)+0.5d0*dxi
11991 ymedi=c(2,i)+0.5d0*dyi
11992 zmedi=c(3,i)+0.5d0*dzi
11993 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
11994 num_conti=num_cont_hb(i)
11995 do j=ielstart(i),ielend(i)
11996 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
11997 call eelecij_scale(i,j,ees,evdw1,eel_loc)
11999 num_cont_hb(i)=num_conti
12001 ! write (iout,*) "Number of loop steps in EELEC:",ind
12003 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
12004 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
12006 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
12007 !cc eel_loc=eel_loc+eello_turn3
12008 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
12010 end subroutine eelec_scale
12011 !-----------------------------------------------------------------------------
12012 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
12013 ! implicit real*8 (a-h,o-z)
12016 ! include 'DIMENSIONS'
12020 ! include 'COMMON.CONTROL'
12021 ! include 'COMMON.IOUNITS'
12022 ! include 'COMMON.GEO'
12023 ! include 'COMMON.VAR'
12024 ! include 'COMMON.LOCAL'
12025 ! include 'COMMON.CHAIN'
12026 ! include 'COMMON.DERIV'
12027 ! include 'COMMON.INTERACT'
12028 ! include 'COMMON.CONTACTS'
12029 ! include 'COMMON.TORSION'
12030 ! include 'COMMON.VECTORS'
12031 ! include 'COMMON.FFIELD'
12032 ! include 'COMMON.TIME1'
12033 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
12034 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
12035 real(kind=8),dimension(2,2) :: acipa !el,a_temp
12036 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
12037 real(kind=8),dimension(4) :: muij
12038 !el integer :: num_conti,j1,j2
12039 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
12040 !el dz_normi,xmedi,ymedi,zmedi
12041 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
12042 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
12043 !el num_conti,j1,j2
12044 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
12046 real(kind=8) :: scal_el=1.0d0
12048 real(kind=8) :: scal_el=0.5d0
12051 ! 13-go grudnia roku pamietnego...
12052 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
12053 0.0d0,1.0d0,0.0d0,&
12054 0.0d0,0.0d0,1.0d0/),shape(unmat))
12055 !el local variables
12056 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m
12057 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
12058 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
12059 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
12060 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
12061 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
12062 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
12063 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
12064 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
12065 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
12066 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
12067 ecosam,ecosbm,ecosgm,ghalf,time00
12068 ! integer :: maxconts
12069 ! maxconts = nres/4
12070 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12071 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12072 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12073 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12074 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12075 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12076 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12077 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12078 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
12079 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
12080 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
12081 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
12082 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
12084 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
12085 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
12090 !d write (iout,*) "eelecij",i,j
12094 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
12095 aaa=app(iteli,itelj)
12096 bbb=bpp(iteli,itelj)
12097 ael6i=ael6(iteli,itelj)
12098 ael3i=ael3(iteli,itelj)
12102 dx_normj=dc_norm(1,j)
12103 dy_normj=dc_norm(2,j)
12104 dz_normj=dc_norm(3,j)
12105 xj=c(1,j)+0.5D0*dxj-xmedi
12106 yj=c(2,j)+0.5D0*dyj-ymedi
12107 zj=c(3,j)+0.5D0*dzj-zmedi
12108 rij=xj*xj+yj*yj+zj*zj
12112 ! For extracting the short-range part of Evdwpp
12113 sss=sscale(rij/rpp(iteli,itelj))
12117 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
12118 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
12119 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
12120 fac=cosa-3.0D0*cosb*cosg
12122 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
12123 if (j.eq.i+2) ev1=scal_el*ev1
12128 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
12131 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
12132 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
12134 evdw1=evdw1+evdwij*(1.0d0-sss)
12135 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
12136 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
12137 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
12138 !d & xmedi,ymedi,zmedi,xj,yj,zj
12140 if (energy_dec) then
12141 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
12142 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
12146 ! Calculate contributions to the Cartesian gradient.
12149 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)
12150 facel=-3*rrmij*(el1+eesij)
12156 ! Radial derivatives. First process both termini of the fragment (i,j)
12162 ! ghalf=0.5D0*ggg(k)
12163 ! gelc(k,i)=gelc(k,i)+ghalf
12164 ! gelc(k,j)=gelc(k,j)+ghalf
12166 ! 9/28/08 AL Gradient compotents will be summed only at the end
12168 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
12169 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
12172 ! Loop over residues i+1 thru j-1.
12176 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12183 ! ghalf=0.5D0*ggg(k)
12184 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
12185 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
12187 ! 9/28/08 AL Gradient compotents will be summed only at the end
12189 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12190 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12193 ! Loop over residues i+1 thru j-1.
12197 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
12201 facvdw=ev1+evdwij*(1.0d0-sss)
12204 fac=-3*rrmij*(facvdw+facvdw+facel)
12209 ! Radial derivatives. First process both termini of the fragment (i,j)
12215 ! ghalf=0.5D0*ggg(k)
12216 ! gelc(k,i)=gelc(k,i)+ghalf
12217 ! gelc(k,j)=gelc(k,j)+ghalf
12219 ! 9/28/08 AL Gradient compotents will be summed only at the end
12221 gelc_long(k,j)=gelc(k,j)+ggg(k)
12222 gelc_long(k,i)=gelc(k,i)-ggg(k)
12225 ! Loop over residues i+1 thru j-1.
12229 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12232 ! 9/28/08 AL Gradient compotents will be summed only at the end
12237 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12238 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12244 ecosa=2.0D0*fac3*fac1+fac4
12247 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
12248 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
12250 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
12251 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
12253 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
12254 !d & (dcosg(k),k=1,3)
12256 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
12259 ! ghalf=0.5D0*ggg(k)
12260 ! gelc(k,i)=gelc(k,i)+ghalf
12261 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
12262 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12263 ! gelc(k,j)=gelc(k,j)+ghalf
12264 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
12265 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12269 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12273 gelc(k,i)=gelc(k,i) &
12274 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
12275 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12276 gelc(k,j)=gelc(k,j) &
12277 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
12278 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12279 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
12280 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
12282 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
12283 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
12284 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
12286 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
12287 ! energy of a peptide unit is assumed in the form of a second-order
12288 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
12289 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
12290 ! are computed for EVERY pair of non-contiguous peptide groups.
12292 if (j.lt.nres-1) then
12303 muij(kkk)=mu(k,i)*mu(l,j)
12306 !d write (iout,*) 'EELEC: i',i,' j',j
12307 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
12308 !d write(iout,*) 'muij',muij
12309 ury=scalar(uy(1,i),erij)
12310 urz=scalar(uz(1,i),erij)
12311 vry=scalar(uy(1,j),erij)
12312 vrz=scalar(uz(1,j),erij)
12313 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
12314 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
12315 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
12316 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
12317 fac=dsqrt(-ael6i)*r3ij
12322 !d write (iout,'(4i5,4f10.5)')
12323 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
12324 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
12325 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
12326 !d & uy(:,j),uz(:,j)
12327 !d write (iout,'(4f10.5)')
12328 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
12329 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
12330 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
12331 !d write (iout,'(9f10.5/)')
12332 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
12333 ! Derivatives of the elements of A in virtual-bond vectors
12334 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
12336 uryg(k,1)=scalar(erder(1,k),uy(1,i))
12337 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
12338 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
12339 urzg(k,1)=scalar(erder(1,k),uz(1,i))
12340 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
12341 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
12342 vryg(k,1)=scalar(erder(1,k),uy(1,j))
12343 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
12344 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
12345 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
12346 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
12347 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
12349 ! Compute radial contributions to the gradient
12367 ! Add the contributions coming from er
12370 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
12371 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
12372 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
12373 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
12376 ! Derivatives in DC(i)
12377 !grad ghalf1=0.5d0*agg(k,1)
12378 !grad ghalf2=0.5d0*agg(k,2)
12379 !grad ghalf3=0.5d0*agg(k,3)
12380 !grad ghalf4=0.5d0*agg(k,4)
12381 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
12382 -3.0d0*uryg(k,2)*vry)!+ghalf1
12383 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
12384 -3.0d0*uryg(k,2)*vrz)!+ghalf2
12385 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
12386 -3.0d0*urzg(k,2)*vry)!+ghalf3
12387 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
12388 -3.0d0*urzg(k,2)*vrz)!+ghalf4
12389 ! Derivatives in DC(i+1)
12390 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
12391 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
12392 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
12393 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
12394 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
12395 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
12396 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
12397 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
12398 ! Derivatives in DC(j)
12399 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
12400 -3.0d0*vryg(k,2)*ury)!+ghalf1
12401 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
12402 -3.0d0*vrzg(k,2)*ury)!+ghalf2
12403 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
12404 -3.0d0*vryg(k,2)*urz)!+ghalf3
12405 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
12406 -3.0d0*vrzg(k,2)*urz)!+ghalf4
12407 ! Derivatives in DC(j+1) or DC(nres-1)
12408 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
12409 -3.0d0*vryg(k,3)*ury)
12410 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
12411 -3.0d0*vrzg(k,3)*ury)
12412 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
12413 -3.0d0*vryg(k,3)*urz)
12414 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
12415 -3.0d0*vrzg(k,3)*urz)
12416 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
12418 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
12431 aggi(k,l)=-aggi(k,l)
12432 aggi1(k,l)=-aggi1(k,l)
12433 aggj(k,l)=-aggj(k,l)
12434 aggj1(k,l)=-aggj1(k,l)
12437 if (j.lt.nres-1) then
12443 aggi(k,l)=-aggi(k,l)
12444 aggi1(k,l)=-aggi1(k,l)
12445 aggj(k,l)=-aggj(k,l)
12446 aggj1(k,l)=-aggj1(k,l)
12457 aggi(k,l)=-aggi(k,l)
12458 aggi1(k,l)=-aggi1(k,l)
12459 aggj(k,l)=-aggj(k,l)
12460 aggj1(k,l)=-aggj1(k,l)
12465 IF (wel_loc.gt.0.0d0) THEN
12466 ! Contribution to the local-electrostatic energy coming from the i-j pair
12467 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
12469 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
12471 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
12472 'eelloc',i,j,eel_loc_ij
12473 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
12475 eel_loc=eel_loc+eel_loc_ij
12476 ! Partial derivatives in virtual-bond dihedral angles gamma
12478 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
12479 a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
12480 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
12481 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
12482 a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
12483 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
12484 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
12486 ggg(l)=agg(l,1)*muij(1)+ &
12487 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
12488 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
12489 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
12490 !grad ghalf=0.5d0*ggg(l)
12491 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
12492 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
12496 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
12499 ! Remaining derivatives of eello
12501 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ &
12502 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
12503 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ &
12504 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
12505 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ &
12506 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
12507 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ &
12508 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
12511 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
12512 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
12513 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
12514 .and. num_conti.le.maxconts) then
12515 ! write (iout,*) i,j," entered corr"
12517 ! Calculate the contact function. The ith column of the array JCONT will
12518 ! contain the numbers of atoms that make contacts with the atom I (of numbers
12519 ! greater than I). The arrays FACONT and GACONT will contain the values of
12520 ! the contact function and its derivative.
12521 ! r0ij=1.02D0*rpp(iteli,itelj)
12522 ! r0ij=1.11D0*rpp(iteli,itelj)
12523 r0ij=2.20D0*rpp(iteli,itelj)
12524 ! r0ij=1.55D0*rpp(iteli,itelj)
12525 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
12526 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
12527 if (fcont.gt.0.0D0) then
12528 num_conti=num_conti+1
12529 if (num_conti.gt.maxconts) then
12530 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
12531 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
12532 ' will skip next contacts for this conf.',num_conti
12534 jcont_hb(num_conti,i)=j
12535 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
12536 !d & " jcont_hb",jcont_hb(num_conti,i)
12537 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
12538 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
12539 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
12541 d_cont(num_conti,i)=rij
12542 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
12543 ! --- Electrostatic-interaction matrix ---
12544 a_chuj(1,1,num_conti,i)=a22
12545 a_chuj(1,2,num_conti,i)=a23
12546 a_chuj(2,1,num_conti,i)=a32
12547 a_chuj(2,2,num_conti,i)=a33
12548 ! --- Gradient of rij
12550 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
12557 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
12558 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
12559 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
12560 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
12561 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
12566 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
12567 ! Calculate contact energies
12569 wij=cosa-3.0D0*cosb*cosg
12572 ! fac3=dsqrt(-ael6i)/r0ij**3
12573 fac3=dsqrt(-ael6i)*r3ij
12574 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
12575 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
12576 if (ees0tmp.gt.0) then
12577 ees0pij=dsqrt(ees0tmp)
12581 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
12582 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
12583 if (ees0tmp.gt.0) then
12584 ees0mij=dsqrt(ees0tmp)
12589 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
12590 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
12591 ! Diagnostics. Comment out or remove after debugging!
12592 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
12593 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
12594 ! ees0m(num_conti,i)=0.0D0
12596 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
12597 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
12598 ! Angular derivatives of the contact function
12599 ees0pij1=fac3/ees0pij
12600 ees0mij1=fac3/ees0mij
12601 fac3p=-3.0D0*fac3*rrmij
12602 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
12603 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
12605 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
12606 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
12607 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
12608 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
12609 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
12610 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
12611 ecosap=ecosa1+ecosa2
12612 ecosbp=ecosb1+ecosb2
12613 ecosgp=ecosg1+ecosg2
12614 ecosam=ecosa1-ecosa2
12615 ecosbm=ecosb1-ecosb2
12616 ecosgm=ecosg1-ecosg2
12625 facont_hb(num_conti,i)=fcont
12626 fprimcont=fprimcont/rij
12627 !d facont_hb(num_conti,i)=1.0D0
12628 ! Following line is for diagnostics.
12631 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
12632 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
12635 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
12636 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
12638 gggp(1)=gggp(1)+ees0pijp*xj
12639 gggp(2)=gggp(2)+ees0pijp*yj
12640 gggp(3)=gggp(3)+ees0pijp*zj
12641 gggm(1)=gggm(1)+ees0mijp*xj
12642 gggm(2)=gggm(2)+ees0mijp*yj
12643 gggm(3)=gggm(3)+ees0mijp*zj
12644 ! Derivatives due to the contact function
12645 gacont_hbr(1,num_conti,i)=fprimcont*xj
12646 gacont_hbr(2,num_conti,i)=fprimcont*yj
12647 gacont_hbr(3,num_conti,i)=fprimcont*zj
12650 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
12651 ! following the change of gradient-summation algorithm.
12653 !grad ghalfp=0.5D0*gggp(k)
12654 !grad ghalfm=0.5D0*gggm(k)
12655 gacontp_hb1(k,num_conti,i)= & !ghalfp
12656 +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
12657 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12658 gacontp_hb2(k,num_conti,i)= & !ghalfp
12659 +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
12660 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12661 gacontp_hb3(k,num_conti,i)=gggp(k)
12662 gacontm_hb1(k,num_conti,i)= &!ghalfm
12663 +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
12664 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12665 gacontm_hb2(k,num_conti,i)= & !ghalfm
12666 +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
12667 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12668 gacontm_hb3(k,num_conti,i)=gggm(k)
12671 endif ! num_conti.le.maxconts
12674 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
12677 ghalf=0.5d0*agg(l,k)
12678 aggi(l,k)=aggi(l,k)+ghalf
12679 aggi1(l,k)=aggi1(l,k)+agg(l,k)
12680 aggj(l,k)=aggj(l,k)+ghalf
12683 if (j.eq.nres-1 .and. i.lt.j-2) then
12686 aggj1(l,k)=aggj1(l,k)+agg(l,k)
12691 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
12693 end subroutine eelecij_scale
12694 !-----------------------------------------------------------------------------
12695 subroutine evdwpp_short(evdw1)
12699 ! implicit real*8 (a-h,o-z)
12700 ! include 'DIMENSIONS'
12701 ! include 'COMMON.CONTROL'
12702 ! include 'COMMON.IOUNITS'
12703 ! include 'COMMON.GEO'
12704 ! include 'COMMON.VAR'
12705 ! include 'COMMON.LOCAL'
12706 ! include 'COMMON.CHAIN'
12707 ! include 'COMMON.DERIV'
12708 ! include 'COMMON.INTERACT'
12709 ! include 'COMMON.CONTACTS'
12710 ! include 'COMMON.TORSION'
12711 ! include 'COMMON.VECTORS'
12712 ! include 'COMMON.FFIELD'
12713 real(kind=8),dimension(3) :: ggg
12714 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
12716 real(kind=8) :: scal_el=1.0d0
12718 real(kind=8) :: scal_el=0.5d0
12720 !el local variables
12721 integer :: i,j,k,iteli,itelj,num_conti
12722 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
12723 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
12724 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
12725 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
12728 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
12729 ! & " iatel_e_vdw",iatel_e_vdw
12731 do i=iatel_s_vdw,iatel_e_vdw
12732 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle
12736 dx_normi=dc_norm(1,i)
12737 dy_normi=dc_norm(2,i)
12738 dz_normi=dc_norm(3,i)
12739 xmedi=c(1,i)+0.5d0*dxi
12740 ymedi=c(2,i)+0.5d0*dyi
12741 zmedi=c(3,i)+0.5d0*dzi
12743 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
12744 ! & ' ielend',ielend_vdw(i)
12746 do j=ielstart_vdw(i),ielend_vdw(i)
12747 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
12751 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
12752 aaa=app(iteli,itelj)
12753 bbb=bpp(iteli,itelj)
12757 dx_normj=dc_norm(1,j)
12758 dy_normj=dc_norm(2,j)
12759 dz_normj=dc_norm(3,j)
12760 xj=c(1,j)+0.5D0*dxj-xmedi
12761 yj=c(2,j)+0.5D0*dyj-ymedi
12762 zj=c(3,j)+0.5D0*dzj-zmedi
12763 rij=xj*xj+yj*yj+zj*zj
12766 sss=sscale(rij/rpp(iteli,itelj))
12767 if (sss.gt.0.0d0) then
12772 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
12773 if (j.eq.i+2) ev1=scal_el*ev1
12776 if (energy_dec) then
12777 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
12779 evdw1=evdw1+evdwij*sss
12781 ! Calculate contributions to the Cartesian gradient.
12783 facvdw=-6*rrmij*(ev1+evdwij)*sss
12788 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12789 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12795 end subroutine evdwpp_short
12796 !-----------------------------------------------------------------------------
12797 subroutine escp_long(evdw2,evdw2_14)
12799 ! This subroutine calculates the excluded-volume interaction energy between
12800 ! peptide-group centers and side chains and its gradient in virtual-bond and
12801 ! side-chain vectors.
12803 ! implicit real*8 (a-h,o-z)
12804 ! include 'DIMENSIONS'
12805 ! include 'COMMON.GEO'
12806 ! include 'COMMON.VAR'
12807 ! include 'COMMON.LOCAL'
12808 ! include 'COMMON.CHAIN'
12809 ! include 'COMMON.DERIV'
12810 ! include 'COMMON.INTERACT'
12811 ! include 'COMMON.FFIELD'
12812 ! include 'COMMON.IOUNITS'
12813 ! include 'COMMON.CONTROL'
12814 real(kind=8),dimension(3) :: ggg
12815 !el local variables
12816 integer :: i,iint,j,k,iteli,itypj
12817 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2
12818 real(kind=8) :: evdw2,evdw2_14,evdwij
12821 !d print '(a)','Enter ESCP'
12822 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
12823 do i=iatscp_s,iatscp_e
12824 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
12826 xi=0.5D0*(c(1,i)+c(1,i+1))
12827 yi=0.5D0*(c(2,i)+c(2,i+1))
12828 zi=0.5D0*(c(3,i)+c(3,i+1))
12830 do iint=1,nscp_gr(i)
12832 do j=iscpstart(i,iint),iscpend(i,iint)
12834 if (itypj.eq.ntyp1) cycle
12835 ! Uncomment following three lines for SC-p interactions
12836 ! xj=c(1,nres+j)-xi
12837 ! yj=c(2,nres+j)-yi
12838 ! zj=c(3,nres+j)-zi
12839 ! Uncomment following three lines for Ca-p interactions
12843 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12845 sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
12847 if (sss.lt.1.0d0) then
12850 e1=fac*fac*aad(itypj,iteli)
12851 e2=fac*bad(itypj,iteli)
12852 if (iabs(j-i) .le. 2) then
12855 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)
12858 evdw2=evdw2+evdwij*(1.0d0-sss)
12859 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
12860 'evdw2',i,j,sss,evdwij
12862 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
12864 fac=-(evdwij+e1)*rrij*(1.0d0-sss)
12868 ! Uncomment following three lines for SC-p interactions
12870 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
12872 ! Uncomment following line for SC-p interactions
12873 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
12875 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
12876 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
12885 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
12886 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
12887 gradx_scp(j,i)=expon*gradx_scp(j,i)
12890 !******************************************************************************
12894 ! To save time the factor EXPON has been extracted from ALL components
12895 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12898 !******************************************************************************
12900 end subroutine escp_long
12901 !-----------------------------------------------------------------------------
12902 subroutine escp_short(evdw2,evdw2_14)
12904 ! This subroutine calculates the excluded-volume interaction energy between
12905 ! peptide-group centers and side chains and its gradient in virtual-bond and
12906 ! side-chain vectors.
12908 ! implicit real*8 (a-h,o-z)
12909 ! include 'DIMENSIONS'
12910 ! include 'COMMON.GEO'
12911 ! include 'COMMON.VAR'
12912 ! include 'COMMON.LOCAL'
12913 ! include 'COMMON.CHAIN'
12914 ! include 'COMMON.DERIV'
12915 ! include 'COMMON.INTERACT'
12916 ! include 'COMMON.FFIELD'
12917 ! include 'COMMON.IOUNITS'
12918 ! include 'COMMON.CONTROL'
12919 real(kind=8),dimension(3) :: ggg
12920 !el local variables
12921 integer :: i,iint,j,k,iteli,itypj
12922 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2
12923 real(kind=8) :: evdw2,evdw2_14,evdwij
12926 !d print '(a)','Enter ESCP'
12927 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
12928 do i=iatscp_s,iatscp_e
12929 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
12931 xi=0.5D0*(c(1,i)+c(1,i+1))
12932 yi=0.5D0*(c(2,i)+c(2,i+1))
12933 zi=0.5D0*(c(3,i)+c(3,i+1))
12935 do iint=1,nscp_gr(i)
12937 do j=iscpstart(i,iint),iscpend(i,iint)
12939 if (itypj.eq.ntyp1) cycle
12940 ! Uncomment following three lines for SC-p interactions
12941 ! xj=c(1,nres+j)-xi
12942 ! yj=c(2,nres+j)-yi
12943 ! zj=c(3,nres+j)-zi
12944 ! Uncomment following three lines for Ca-p interactions
12948 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12950 sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
12952 if (sss.gt.0.0d0) then
12955 e1=fac*fac*aad(itypj,iteli)
12956 e2=fac*bad(itypj,iteli)
12957 if (iabs(j-i) .le. 2) then
12960 evdw2_14=evdw2_14+(e1+e2)*sss
12963 evdw2=evdw2+evdwij*sss
12964 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
12965 'evdw2',i,j,sss,evdwij
12967 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
12969 fac=-(evdwij+e1)*rrij*sss
12973 ! Uncomment following three lines for SC-p interactions
12975 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
12977 ! Uncomment following line for SC-p interactions
12978 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
12980 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
12981 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
12990 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
12991 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
12992 gradx_scp(j,i)=expon*gradx_scp(j,i)
12995 !******************************************************************************
12999 ! To save time the factor EXPON has been extracted from ALL components
13000 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
13003 !******************************************************************************
13005 end subroutine escp_short
13006 !-----------------------------------------------------------------------------
13007 ! energy_p_new-sep_barrier.F
13008 !-----------------------------------------------------------------------------
13009 subroutine sc_grad_scale(scalfac)
13010 ! implicit real*8 (a-h,o-z)
13012 ! include 'DIMENSIONS'
13013 ! include 'COMMON.CHAIN'
13014 ! include 'COMMON.DERIV'
13015 ! include 'COMMON.CALC'
13016 ! include 'COMMON.IOUNITS'
13017 real(kind=8),dimension(3) :: dcosom1,dcosom2
13018 real(kind=8) :: scalfac
13019 !el local variables
13020 ! integer :: i,j,k,l
13022 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
13023 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
13024 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
13025 -2.0D0*alf12*eps3der+sigder*sigsq_om12
13029 ! eom12=evdwij*eps1_om12
13031 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
13032 ! & " sigder",sigder
13033 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
13034 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
13036 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
13037 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
13040 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac
13042 ! write (iout,*) "gg",(gg(k),k=1,3)
13044 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
13045 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
13046 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac
13047 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
13048 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
13049 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac
13050 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
13051 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
13052 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
13053 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
13056 ! Calculate the components of the gradient in DC and X
13059 gvdwc(l,i)=gvdwc(l,i)-gg(l)
13060 gvdwc(l,j)=gvdwc(l,j)+gg(l)
13063 end subroutine sc_grad_scale
13064 !-----------------------------------------------------------------------------
13065 ! energy_split-sep.F
13066 !-----------------------------------------------------------------------------
13067 subroutine etotal_long(energia)
13069 ! Compute the long-range slow-varying contributions to the energy
13071 ! implicit real*8 (a-h,o-z)
13072 ! include 'DIMENSIONS'
13073 use MD_data, only: totT
13077 !MS$ATTRIBUTES C :: proc_proc
13082 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
13084 ! include 'COMMON.SETUP'
13085 ! include 'COMMON.IOUNITS'
13086 ! include 'COMMON.FFIELD'
13087 ! include 'COMMON.DERIV'
13088 ! include 'COMMON.INTERACT'
13089 ! include 'COMMON.SBRIDGE'
13090 ! include 'COMMON.CHAIN'
13091 ! include 'COMMON.VAR'
13092 ! include 'COMMON.LOCAL'
13093 ! include 'COMMON.MD'
13094 real(kind=8),dimension(0:n_ene) :: energia
13095 !el local variables
13096 integer :: i,n_corr,n_corr1,ierror,ierr
13097 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
13098 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
13099 ecorr,ecorr5,ecorr6,eturn6,time00
13100 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
13101 !elwrite(iout,*)"in etotal long"
13103 if (modecalc.eq.12.or.modecalc.eq.14) then
13105 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
13107 call int_from_cart1(.false.)
13110 !elwrite(iout,*)"in etotal long"
13113 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
13114 ! & " absolute rank",myrank," nfgtasks",nfgtasks
13116 if (nfgtasks.gt.1) then
13118 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
13119 if (fg_rank.eq.0) then
13120 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
13121 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
13123 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
13124 ! FG slaves as WEIGHTS array.
13131 weights_(7)=wel_loc
13134 weights_(10)=wturn6
13136 weights_(12)=wscloc
13138 weights_(14)=wtor_d
13139 weights_(15)=wstrain
13140 weights_(16)=wvdwpp
13142 weights_(18)=scal14
13143 weights_(21)=wsccor
13144 ! FG Master broadcasts the WEIGHTS_ array
13145 call MPI_Bcast(weights_(1),n_ene,&
13146 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13148 ! FG slaves receive the WEIGHTS array
13149 call MPI_Bcast(weights(1),n_ene,&
13150 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13165 wstrain=weights(15)
13171 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
13173 time_Bcast=time_Bcast+MPI_Wtime()-time00
13174 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
13175 ! call chainbuild_cart
13176 ! call int_from_cart1(.false.)
13178 ! write (iout,*) 'Processor',myrank,
13179 ! & ' calling etotal_short ipot=',ipot
13181 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
13183 !d print *,'nnt=',nnt,' nct=',nct
13185 !elwrite(iout,*)"in etotal long"
13186 ! Compute the side-chain and electrostatic interaction energy
13188 goto (101,102,103,104,105,106) ipot
13189 ! Lennard-Jones potential.
13190 101 call elj_long(evdw)
13191 !d print '(a)','Exit ELJ'
13193 ! Lennard-Jones-Kihara potential (shifted).
13194 102 call eljk_long(evdw)
13196 ! Berne-Pechukas potential (dilated LJ, angular dependence).
13197 103 call ebp_long(evdw)
13199 ! Gay-Berne potential (shifted LJ, angular dependence).
13200 104 call egb_long(evdw)
13202 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
13203 105 call egbv_long(evdw)
13205 ! Soft-sphere potential
13206 106 call e_softsphere(evdw)
13208 ! Calculate electrostatic (H-bonding) energy of the main chain.
13212 if (ipot.lt.6) then
13214 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
13215 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
13216 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
13217 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
13219 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
13220 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
13221 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
13222 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
13224 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13233 ! write (iout,*) "Soft-spheer ELEC potential"
13234 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
13238 ! Calculate excluded-volume interaction energy between peptide groups
13241 if (ipot.lt.6) then
13242 if(wscp.gt.0d0) then
13243 call escp_long(evdw2,evdw2_14)
13249 call escp_soft_sphere(evdw2,evdw2_14)
13252 ! 12/1/95 Multi-body terms
13256 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
13257 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
13258 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
13259 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
13260 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
13267 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
13268 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
13271 ! If performing constraint dynamics, call the constraint energy
13272 ! after the equilibration time
13273 if(usampl.and.totT.gt.eq_time) then
13288 energia(2)=evdw2-evdw2_14
13289 energia(18)=evdw2_14
13298 energia(3)=ees+evdw1
13305 energia(8)=eello_turn3
13306 energia(9)=eello_turn4
13308 energia(20)=Uconst+Uconst_back
13309 call sum_energy(energia,.true.)
13310 ! write (iout,*) "Exit ETOTAL_LONG"
13313 end subroutine etotal_long
13314 !-----------------------------------------------------------------------------
13315 subroutine etotal_short(energia)
13317 ! Compute the short-range fast-varying contributions to the energy
13319 ! implicit real*8 (a-h,o-z)
13320 ! include 'DIMENSIONS'
13324 !MS$ATTRIBUTES C :: proc_proc
13329 integer :: ierror,ierr
13330 real(kind=8),dimension(n_ene) :: weights_
13331 real(kind=8) :: time00
13333 ! include 'COMMON.SETUP'
13334 ! include 'COMMON.IOUNITS'
13335 ! include 'COMMON.FFIELD'
13336 ! include 'COMMON.DERIV'
13337 ! include 'COMMON.INTERACT'
13338 ! include 'COMMON.SBRIDGE'
13339 ! include 'COMMON.CHAIN'
13340 ! include 'COMMON.VAR'
13341 ! include 'COMMON.LOCAL'
13342 real(kind=8),dimension(0:n_ene) :: energia
13343 !el local variables
13345 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
13346 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr
13349 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
13351 if (modecalc.eq.12.or.modecalc.eq.14) then
13353 if (fg_rank.eq.0) call int_from_cart1(.false.)
13355 call int_from_cart1(.false.)
13359 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
13360 ! & " absolute rank",myrank," nfgtasks",nfgtasks
13362 if (nfgtasks.gt.1) then
13364 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
13365 if (fg_rank.eq.0) then
13366 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
13367 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
13369 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
13370 ! FG slaves as WEIGHTS array.
13377 weights_(7)=wel_loc
13380 weights_(10)=wturn6
13382 weights_(12)=wscloc
13384 weights_(14)=wtor_d
13385 weights_(15)=wstrain
13386 weights_(16)=wvdwpp
13388 weights_(18)=scal14
13389 weights_(21)=wsccor
13390 ! FG Master broadcasts the WEIGHTS_ array
13391 call MPI_Bcast(weights_(1),n_ene,&
13392 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13394 ! FG slaves receive the WEIGHTS array
13395 call MPI_Bcast(weights(1),n_ene,&
13396 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13411 wstrain=weights(15)
13417 ! write (iout,*),"Processor",myrank," BROADCAST weights"
13418 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
13420 ! write (iout,*) "Processor",myrank," BROADCAST c"
13421 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
13423 ! write (iout,*) "Processor",myrank," BROADCAST dc"
13424 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
13426 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
13427 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
13429 ! write (iout,*) "Processor",myrank," BROADCAST theta"
13430 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
13432 ! write (iout,*) "Processor",myrank," BROADCAST phi"
13433 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
13435 ! write (iout,*) "Processor",myrank," BROADCAST alph"
13436 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
13438 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
13439 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
13441 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
13442 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
13444 time_Bcast=time_Bcast+MPI_Wtime()-time00
13445 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
13447 ! write (iout,*) 'Processor',myrank,
13448 ! & ' calling etotal_short ipot=',ipot
13450 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
13452 ! call int_from_cart1(.false.)
13454 ! Compute the side-chain and electrostatic interaction energy
13456 goto (101,102,103,104,105,106) ipot
13457 ! Lennard-Jones potential.
13458 101 call elj_short(evdw)
13459 !d print '(a)','Exit ELJ'
13461 ! Lennard-Jones-Kihara potential (shifted).
13462 102 call eljk_short(evdw)
13464 ! Berne-Pechukas potential (dilated LJ, angular dependence).
13465 103 call ebp_short(evdw)
13467 ! Gay-Berne potential (shifted LJ, angular dependence).
13468 104 call egb_short(evdw)
13470 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
13471 105 call egbv_short(evdw)
13473 ! Soft-sphere potential - already dealt with in the long-range part
13475 ! 106 call e_softsphere_short(evdw)
13477 ! Calculate electrostatic (H-bonding) energy of the main chain.
13481 ! Calculate the short-range part of Evdwpp
13483 call evdwpp_short(evdw1)
13485 ! Calculate the short-range part of ESCp
13487 if (ipot.lt.6) then
13488 call escp_short(evdw2,evdw2_14)
13491 ! Calculate the bond-stretching energy
13495 ! Calculate the disulfide-bridge and other energy and the contributions
13496 ! from other distance constraints.
13499 ! Calculate the virtual-bond-angle energy.
13503 ! Calculate the SC local energy.
13508 ! Calculate the virtual-bond torsional energy.
13510 call etor(etors,edihcnstr)
13512 ! 6/23/01 Calculate double-torsional energy
13514 call etor_d(etors_d)
13516 ! 21/5/07 Calculate local sicdechain correlation energy
13518 if (wsccor.gt.0.0d0) then
13519 call eback_sc_corr(esccor)
13524 ! Put energy components into an array
13531 energia(2)=evdw2-evdw2_14
13532 energia(18)=evdw2_14
13545 energia(14)=etors_d
13548 energia(19)=edihcnstr
13550 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
13552 call sum_energy(energia,.true.)
13553 ! write (iout,*) "Exit ETOTAL_SHORT"
13556 end subroutine etotal_short
13557 !-----------------------------------------------------------------------------
13559 !-----------------------------------------------------------------------------
13560 real(kind=8) function gnmr1(y,ymin,ymax)
13562 real(kind=8) :: y,ymin,ymax
13563 real(kind=8) :: wykl=4.0d0
13564 if (y.lt.ymin) then
13565 gnmr1=(ymin-y)**wykl/wykl
13566 else if (y.gt.ymax) then
13567 gnmr1=(y-ymax)**wykl/wykl
13573 !-----------------------------------------------------------------------------
13574 real(kind=8) function gnmr1prim(y,ymin,ymax)
13576 real(kind=8) :: y,ymin,ymax
13577 real(kind=8) :: wykl=4.0d0
13578 if (y.lt.ymin) then
13579 gnmr1prim=-(ymin-y)**(wykl-1)
13580 else if (y.gt.ymax) then
13581 gnmr1prim=(y-ymax)**(wykl-1)
13586 end function gnmr1prim
13587 !-----------------------------------------------------------------------------
13588 real(kind=8) function harmonic(y,ymax)
13590 real(kind=8) :: y,ymax
13591 real(kind=8) :: wykl=2.0d0
13592 harmonic=(y-ymax)**wykl
13594 end function harmonic
13595 !-----------------------------------------------------------------------------
13596 real(kind=8) function harmonicprim(y,ymax)
13597 real(kind=8) :: y,ymin,ymax
13598 real(kind=8) :: wykl=2.0d0
13599 harmonicprim=(y-ymax)*wykl
13601 end function harmonicprim
13602 !-----------------------------------------------------------------------------
13604 !-----------------------------------------------------------------------------
13605 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
13607 use io_base, only:intout,briefout
13608 ! implicit real*8 (a-h,o-z)
13609 ! include 'DIMENSIONS'
13610 ! include 'COMMON.CHAIN'
13611 ! include 'COMMON.DERIV'
13612 ! include 'COMMON.VAR'
13613 ! include 'COMMON.INTERACT'
13614 ! include 'COMMON.FFIELD'
13615 ! include 'COMMON.MD'
13616 ! include 'COMMON.IOUNITS'
13617 real(kind=8),external :: ufparm
13618 integer :: uiparm(1)
13619 real(kind=8) :: urparm(1)
13620 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
13621 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
13622 integer :: n,nf,ind,ind1,i,k,j
13624 ! This subroutine calculates total internal coordinate gradient.
13625 ! Depending on the number of function evaluations, either whole energy
13626 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
13627 ! internal coordinates are reevaluated or only the cartesian-in-internal
13628 ! coordinate derivatives are evaluated. The subroutine was designed to work
13634 !d print *,'grad',nf,icg
13635 if (nf-nfl+1) 20,30,40
13636 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
13637 ! write (iout,*) 'grad 20'
13638 if (nf.eq.0) return
13640 30 call var_to_geom(n,x)
13642 ! write (iout,*) 'grad 30'
13644 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
13647 ! write (iout,*) 'grad 40'
13648 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
13650 ! Convert the Cartesian gradient into internal-coordinate gradient.
13660 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
13662 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
13665 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
13671 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
13673 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
13674 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
13677 if (i.gt.1) g(i-1)=gphii
13678 if (n.gt.nphi) g(nphi+i)=gthetai
13680 if (n.le.nphi+ntheta) goto 10
13682 if (itype(i).ne.10) then
13686 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
13689 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
13691 g(ialph(i,1))=galphai
13692 g(ialph(i,1)+nside)=gomegai
13696 ! Add the components corresponding to local energy terms.
13700 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
13701 g(i)=g(i)+gloc(i,icg)
13703 ! Uncomment following three lines for diagnostics.
13705 !elwrite(iout,*) "in gradient after calling intout"
13706 !d call briefout(0,0.0d0)
13707 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
13709 end subroutine gradient
13710 !-----------------------------------------------------------------------------
13711 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
13714 ! implicit real*8 (a-h,o-z)
13715 ! include 'DIMENSIONS'
13716 ! include 'COMMON.DERIV'
13717 ! include 'COMMON.IOUNITS'
13718 ! include 'COMMON.GEO'
13721 !el common /chuju/ jjj
13722 real(kind=8) :: energia(0:n_ene)
13723 integer :: uiparm(1)
13724 real(kind=8) :: urparm(1)
13726 real(kind=8),external :: ufparm
13727 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
13728 ! if (jjj.gt.0) then
13729 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
13733 !d print *,'func',nf,nfl,icg
13734 call var_to_geom(n,x)
13737 !d write (iout,*) 'ETOTAL called from FUNC'
13738 call etotal(energia)
13741 ! if (jjj.gt.0) then
13742 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
13743 ! write (iout,*) 'f=',etot
13747 end subroutine func
13748 !-----------------------------------------------------------------------------
13749 subroutine cartgrad
13750 ! implicit real*8 (a-h,o-z)
13751 ! include 'DIMENSIONS'
13753 use MD_data, only: totT
13757 ! include 'COMMON.CHAIN'
13758 ! include 'COMMON.DERIV'
13759 ! include 'COMMON.VAR'
13760 ! include 'COMMON.INTERACT'
13761 ! include 'COMMON.FFIELD'
13762 ! include 'COMMON.MD'
13763 ! include 'COMMON.IOUNITS'
13764 ! include 'COMMON.TIME1'
13768 ! This subrouting calculates total Cartesian coordinate gradient.
13769 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
13779 !el write (iout,*) "After sum_gradient"
13781 !el write (iout,*) "After sum_gradient"
13783 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
13784 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
13787 ! If performing constraint dynamics, add the gradients of the constraint energy
13788 if(usampl.and.totT.gt.eq_time) then
13791 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
13792 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
13796 gloc(i,icg)=gloc(i,icg)+dugamma(i)
13799 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
13802 !elwrite (iout,*) "After sum_gradient"
13807 !elwrite (iout,*) "After sum_gradient"
13809 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
13811 ! call checkintcartgrad
13812 ! write(iout,*) 'calling int_to_cart'
13814 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
13818 gcart(j,i)=gradc(j,i,icg)
13819 gxcart(j,i)=gradx(j,i,icg)
13822 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
13823 (gxcart(j,i),j=1,3),gloc(i,icg)
13831 time_inttocart=time_inttocart+MPI_Wtime()-time01
13834 write (iout,*) "gcart and gxcart after int_to_cart"
13836 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
13837 (gxcart(j,i),j=1,3)
13841 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
13845 end subroutine cartgrad
13846 !-----------------------------------------------------------------------------
13847 subroutine zerograd
13848 ! implicit real*8 (a-h,o-z)
13849 ! include 'DIMENSIONS'
13850 ! include 'COMMON.DERIV'
13851 ! include 'COMMON.CHAIN'
13852 ! include 'COMMON.VAR'
13853 ! include 'COMMON.MD'
13854 ! include 'COMMON.SCCOR'
13856 !el local variables
13857 integer :: i,j,intertyp
13858 ! Initialize Cartesian-coordinate gradient
13860 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
13861 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
13863 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
13864 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
13865 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
13866 ! allocate(gradcorr_long(3,nres))
13867 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
13868 ! allocate(gcorr6_turn_long(3,nres))
13869 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
13871 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
13873 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
13874 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
13876 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
13877 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
13879 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
13880 ! allocate(gscloc(3,nres)) !(3,maxres)
13881 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
13885 ! common /deriv_scloc/
13886 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
13887 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
13888 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
13890 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
13894 ! gradc(j,i,icg)=0.0d0
13895 ! gradx(j,i,icg)=0.0d0
13897 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
13898 !elwrite(iout,*) "icg",icg
13902 gradx_scp(j,i)=0.0D0
13904 gvdwc_scp(j,i)=0.0D0
13905 gvdwc_scpp(j,i)=0.0d0
13907 gelc_long(j,i)=0.0D0
13912 gel_loc_long(j,i)=0.0d0
13915 gcorr3_turn(j,i)=0.0d0
13916 gcorr4_turn(j,i)=0.0d0
13917 gradcorr(j,i)=0.0d0
13918 gradcorr_long(j,i)=0.0d0
13919 gradcorr5_long(j,i)=0.0d0
13920 gradcorr6_long(j,i)=0.0d0
13921 gcorr6_turn_long(j,i)=0.0d0
13922 gradcorr5(j,i)=0.0d0
13923 gradcorr6(j,i)=0.0d0
13924 gcorr6_turn(j,i)=0.0d0
13927 gradc(j,i,icg)=0.0d0
13928 gradx(j,i,icg)=0.0d0
13932 gloc_sc(intertyp,i,icg)=0.0d0
13937 ! Initialize the gradient of local energy terms.
13939 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
13940 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
13941 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
13942 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
13943 ! allocate(gel_loc_turn3(nres))
13944 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
13945 ! allocate(gsccor_loc(nres)) !(maxres)
13951 gel_loc_loc(i)=0.0d0
13953 g_corr5_loc(i)=0.0d0
13954 g_corr6_loc(i)=0.0d0
13955 gel_loc_turn3(i)=0.0d0
13956 gel_loc_turn4(i)=0.0d0
13957 gel_loc_turn6(i)=0.0d0
13958 gsccor_loc(i)=0.0d0
13960 ! initialize gcart and gxcart
13961 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
13969 end subroutine zerograd
13970 !-----------------------------------------------------------------------------
13971 real(kind=8) function fdum()
13975 !-----------------------------------------------------------------------------
13977 !-----------------------------------------------------------------------------
13978 subroutine intcartderiv
13979 ! implicit real*8 (a-h,o-z)
13980 ! include 'DIMENSIONS'
13984 ! include 'COMMON.SETUP'
13985 ! include 'COMMON.CHAIN'
13986 ! include 'COMMON.VAR'
13987 ! include 'COMMON.GEO'
13988 ! include 'COMMON.INTERACT'
13989 ! include 'COMMON.DERIV'
13990 ! include 'COMMON.IOUNITS'
13991 ! include 'COMMON.LOCAL'
13992 ! include 'COMMON.SCCOR'
13993 real(kind=8) :: pi4,pi34
13994 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
13995 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
13996 dcosomega,dsinomega !(3,3,maxres)
13997 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
14000 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
14001 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
14002 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
14003 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
14007 !el from module energy-------------
14008 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
14009 !el allocate(dsintau(3,3,3,itau_start:itau_end))
14010 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
14012 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
14013 !el allocate(dsintau(3,3,3,0:nres2))
14014 !el allocate(dtauangle(3,3,3,0:nres2))
14015 !el allocate(domicron(3,2,2,0:nres2))
14016 !el allocate(dcosomicron(3,2,2,0:nres2))
14020 #if defined(MPI) && defined(PARINTDER)
14021 if (nfgtasks.gt.1 .and. me.eq.king) &
14022 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
14027 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
14028 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
14030 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
14033 dtheta(j,1,i)=0.0d0
14034 dtheta(j,2,i)=0.0d0
14040 ! Derivatives of theta's
14041 #if defined(MPI) && defined(PARINTDER)
14042 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
14043 do i=max0(ithet_start-1,3),ithet_end
14047 cost=dcos(theta(i))
14048 sint=sqrt(1-cost*cost)
14050 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
14052 if (itype(i-1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
14053 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
14055 if (itype(i-1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
14058 #if defined(MPI) && defined(PARINTDER)
14059 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
14060 do i=max0(ithet_start-1,3),ithet_end
14064 if ((itype(i-1).ne.10).and.(itype(i-1).ne.ntyp1)) then
14065 cost1=dcos(omicron(1,i))
14066 sint1=sqrt(1-cost1*cost1)
14067 cost2=dcos(omicron(2,i))
14068 sint2=sqrt(1-cost2*cost2)
14070 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
14071 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
14072 cost1*dc_norm(j,i-2))/ &
14074 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
14075 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
14076 +cost1*(dc_norm(j,i-1+nres)))/ &
14078 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
14079 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
14080 !C Looks messy but better than if in loop
14081 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
14082 +cost2*dc_norm(j,i-1))/ &
14084 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
14085 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
14086 +cost2*(-dc_norm(j,i-1+nres)))/ &
14088 ! write(iout,*) "vbld", i,itype(i),vbld(i-1+nres)
14089 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
14093 !elwrite(iout,*) "after vbld write"
14094 ! Derivatives of phi:
14095 ! If phi is 0 or 180 degrees, then the formulas
14096 ! have to be derived by power series expansion of the
14097 ! conventional formulas around 0 and 180.
14099 do i=iphi1_start,iphi1_end
14103 ! if (itype(i-1).eq.21 .or. itype(i-2).eq.21 ) cycle
14104 ! the conventional case
14105 sint=dsin(theta(i))
14106 sint1=dsin(theta(i-1))
14108 cost=dcos(theta(i))
14109 cost1=dcos(theta(i-1))
14111 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
14112 fac0=1.0d0/(sint1*sint)
14115 fac3=cosg*cost1/(sint1*sint1)
14116 fac4=cosg*cost/(sint*sint)
14117 ! Obtaining the gamma derivatives from sine derivative
14118 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
14119 phi(i).gt.pi34.and.phi(i).le.pi.or. &
14120 phi(i).gt.-pi.and.phi(i).le.-pi34) then
14121 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
14122 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
14123 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
14127 cosg_inv=1.0d0/cosg
14128 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
14129 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
14130 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
14131 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
14133 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
14134 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14135 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
14136 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
14137 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
14138 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14139 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
14141 ! Bug fixed 3/24/05 (AL)
14143 ! Obtaining the gamma derivatives from cosine derivative
14146 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
14147 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
14148 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
14149 dc_norm(j,i-3))/vbld(i-2)
14150 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
14151 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
14152 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
14154 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
14155 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
14156 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
14157 dc_norm(j,i-1))/vbld(i)
14158 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
14163 !alculate derivative of Tauangle
14165 do i=itau_start,itau_end
14168 !elwrite(iout,*) " vecpr",i,nres
14170 if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
14171 ! if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10).or.
14172 ! & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1)) cycle
14173 !c dtauangle(j,intertyp,dervityp,residue number)
14174 !c INTERTYP=1 SC...Ca...Ca..Ca
14175 ! the conventional case
14176 sint=dsin(theta(i))
14177 sint1=dsin(omicron(2,i-1))
14178 sing=dsin(tauangle(1,i))
14179 cost=dcos(theta(i))
14180 cost1=dcos(omicron(2,i-1))
14181 cosg=dcos(tauangle(1,i))
14182 !elwrite(iout,*) " vecpr5",i,nres
14184 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
14185 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
14186 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
14187 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
14189 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
14190 fac0=1.0d0/(sint1*sint)
14193 fac3=cosg*cost1/(sint1*sint1)
14194 fac4=cosg*cost/(sint*sint)
14195 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
14196 ! Obtaining the gamma derivatives from sine derivative
14197 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
14198 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
14199 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
14200 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
14201 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
14202 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
14206 cosg_inv=1.0d0/cosg
14207 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
14208 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
14209 *vbld_inv(i-2+nres)
14210 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
14211 dsintau(j,1,2,i)= &
14212 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
14213 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14214 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
14215 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
14216 ! Bug fixed 3/24/05 (AL)
14217 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
14218 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
14219 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14220 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
14222 ! Obtaining the gamma derivatives from cosine derivative
14225 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
14226 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
14227 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
14228 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
14229 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
14230 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
14232 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
14233 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
14234 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
14235 dc_norm(j,i-1))/vbld(i)
14236 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
14237 ! write (iout,*) "else",i
14241 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
14244 !C Second case Ca...Ca...Ca...SC
14246 do i=itau_start,itau_end
14250 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
14251 (itype(i-2).eq.ntyp1).or.(itype(i-3).eq.ntyp1)) cycle
14252 ! the conventional case
14253 sint=dsin(omicron(1,i))
14254 sint1=dsin(theta(i-1))
14255 sing=dsin(tauangle(2,i))
14256 cost=dcos(omicron(1,i))
14257 cost1=dcos(theta(i-1))
14258 cosg=dcos(tauangle(2,i))
14260 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
14262 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
14263 fac0=1.0d0/(sint1*sint)
14266 fac3=cosg*cost1/(sint1*sint1)
14267 fac4=cosg*cost/(sint*sint)
14268 ! Obtaining the gamma derivatives from sine derivative
14269 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
14270 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
14271 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
14272 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
14273 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
14274 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
14278 cosg_inv=1.0d0/cosg
14279 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
14280 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
14281 ! write(iout,*) i,j,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),"dsintau(2,1)"
14283 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
14284 dsintau(j,2,2,i)= &
14285 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
14286 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14287 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
14288 ! & sing*ctgt*domicron(j,1,2,i),
14289 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14290 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
14291 ! Bug fixed 3/24/05 (AL)
14292 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
14293 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
14294 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14295 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
14297 ! Obtaining the gamma derivatives from cosine derivative
14300 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
14301 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
14302 dc_norm(j,i-3))/vbld(i-2)
14303 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
14304 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
14305 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
14306 dcosomicron(j,1,1,i)
14307 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
14308 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
14309 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
14310 dc_norm(j,i-1+nres))/vbld(i-1+nres)
14311 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
14312 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
14317 !CC third case SC...Ca...Ca...SC
14320 do i=itau_start,itau_end
14324 ! the conventional case
14325 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
14326 (itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
14327 sint=dsin(omicron(1,i))
14328 sint1=dsin(omicron(2,i-1))
14329 sing=dsin(tauangle(3,i))
14330 cost=dcos(omicron(1,i))
14331 cost1=dcos(omicron(2,i-1))
14332 cosg=dcos(tauangle(3,i))
14334 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
14335 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
14337 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
14338 fac0=1.0d0/(sint1*sint)
14341 fac3=cosg*cost1/(sint1*sint1)
14342 fac4=cosg*cost/(sint*sint)
14343 ! Obtaining the gamma derivatives from sine derivative
14344 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
14345 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
14346 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
14347 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
14348 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
14349 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
14353 cosg_inv=1.0d0/cosg
14354 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
14355 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
14356 *vbld_inv(i-2+nres)
14357 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
14358 dsintau(j,3,2,i)= &
14359 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
14360 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14361 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
14362 ! Bug fixed 3/24/05 (AL)
14363 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
14364 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
14365 *vbld_inv(i-1+nres)
14366 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14367 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
14369 ! Obtaining the gamma derivatives from cosine derivative
14372 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
14373 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
14374 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
14375 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
14376 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
14377 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
14378 dcosomicron(j,1,1,i)
14379 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
14380 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
14381 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
14382 dc_norm(j,i-1+nres))/vbld(i-1+nres)
14383 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
14384 ! write(iout,*) "else",i
14390 ! Derivatives of side-chain angles alpha and omega
14391 #if defined(MPI) && defined(PARINTDER)
14392 do i=ibond_start,ibond_end
14396 if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then
14397 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
14400 fac8=fac5/vbld(i+1)
14401 fac9=fac5/vbld(i+nres)
14402 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
14403 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
14404 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
14405 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
14406 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
14407 sina=sqrt(1-cosa*cosa)
14409 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
14411 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
14412 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
14413 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
14414 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
14415 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
14416 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
14417 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
14418 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
14420 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
14422 ! obtaining the derivatives of omega from sines
14423 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
14424 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
14425 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
14426 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
14428 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
14429 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
14430 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
14431 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
14432 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
14433 coso_inv=1.0d0/dcos(omeg(i))
14435 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
14436 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
14437 (sino*dc_norm(j,i-1))/vbld(i)
14438 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
14439 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
14440 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
14441 -sino*dc_norm(j,i)/vbld(i+1)
14442 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
14443 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
14444 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
14446 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
14449 ! obtaining the derivatives of omega from cosines
14450 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
14451 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
14456 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
14457 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
14458 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
14459 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
14460 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
14461 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
14462 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
14463 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
14464 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
14465 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
14466 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
14467 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
14468 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
14469 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
14470 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
14476 dalpha(k,j,i)=0.0d0
14477 domega(k,j,i)=0.0d0
14483 #if defined(MPI) && defined(PARINTDER)
14484 if (nfgtasks.gt.1) then
14486 !d write (iout,*) "Gather dtheta"
14487 !d call flush(iout)
14488 write (iout,*) "dtheta before gather"
14490 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
14493 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
14494 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
14495 king,FG_COMM,IERROR)
14497 !d write (iout,*) "Gather dphi"
14498 !d call flush(iout)
14499 write (iout,*) "dphi before gather"
14501 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
14504 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
14505 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
14506 king,FG_COMM,IERROR)
14507 !d write (iout,*) "Gather dalpha"
14508 !d call flush(iout)
14510 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
14511 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
14512 king,FG_COMM,IERROR)
14513 !d write (iout,*) "Gather domega"
14514 !d call flush(iout)
14515 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
14516 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
14517 king,FG_COMM,IERROR)
14522 write (iout,*) "dtheta after gather"
14524 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
14526 write (iout,*) "dphi after gather"
14528 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
14530 write (iout,*) "dalpha after gather"
14532 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
14534 write (iout,*) "domega after gather"
14536 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
14540 end subroutine intcartderiv
14541 !-----------------------------------------------------------------------------
14542 subroutine checkintcartgrad
14543 ! implicit real*8 (a-h,o-z)
14544 ! include 'DIMENSIONS'
14548 ! include 'COMMON.CHAIN'
14549 ! include 'COMMON.VAR'
14550 ! include 'COMMON.GEO'
14551 ! include 'COMMON.INTERACT'
14552 ! include 'COMMON.DERIV'
14553 ! include 'COMMON.IOUNITS'
14554 ! include 'COMMON.SETUP'
14555 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
14556 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
14557 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
14558 real(kind=8),dimension(3) :: dc_norm_s
14559 real(kind=8) :: aincr=1.0d-5
14561 real(kind=8) :: dcji
14564 theta_s(i)=theta(i)
14568 ! Check theta gradient
14570 "Analytical (upper) and numerical (lower) gradient of theta"
14575 dc(j,i-2)=dcji+aincr
14576 call chainbuild_cart
14577 call int_from_cart1(.false.)
14578 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
14581 dc(j,i-1)=dc(j,i-1)+aincr
14582 call chainbuild_cart
14583 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
14586 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
14587 !el (dtheta(j,2,i),j=1,3)
14588 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
14589 !el (dthetanum(j,2,i),j=1,3)
14590 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
14591 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
14592 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
14595 ! Check gamma gradient
14597 "Analytical (upper) and numerical (lower) gradient of gamma"
14601 dc(j,i-3)=dcji+aincr
14602 call chainbuild_cart
14603 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
14606 dc(j,i-2)=dcji+aincr
14607 call chainbuild_cart
14608 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
14611 dc(j,i-1)=dc(j,i-1)+aincr
14612 call chainbuild_cart
14613 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
14616 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
14617 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
14618 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
14619 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
14620 !el write (iout,'(5x,3(3f10.5,5x))') &
14621 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
14622 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
14623 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
14626 ! Check alpha gradient
14628 "Analytical (upper) and numerical (lower) gradient of alpha"
14630 if(itype(i).ne.10) then
14633 dc(j,i-1)=dcji+aincr
14634 call chainbuild_cart
14635 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
14640 call chainbuild_cart
14641 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
14645 dc(j,i+nres)=dc(j,i+nres)+aincr
14646 call chainbuild_cart
14647 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
14652 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
14653 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
14654 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
14655 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
14656 !el write (iout,'(5x,3(3f10.5,5x))') &
14657 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
14658 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
14659 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
14662 ! Check omega gradient
14664 "Analytical (upper) and numerical (lower) gradient of omega"
14666 if(itype(i).ne.10) then
14669 dc(j,i-1)=dcji+aincr
14670 call chainbuild_cart
14671 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
14676 call chainbuild_cart
14677 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
14681 dc(j,i+nres)=dc(j,i+nres)+aincr
14682 call chainbuild_cart
14683 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
14688 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
14689 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
14690 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
14691 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
14692 !el write (iout,'(5x,3(3f10.5,5x))') &
14693 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
14694 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
14695 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
14699 end subroutine checkintcartgrad
14700 !-----------------------------------------------------------------------------
14702 !-----------------------------------------------------------------------------
14703 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
14704 ! implicit real*8 (a-h,o-z)
14705 ! include 'DIMENSIONS'
14706 ! include 'COMMON.IOUNITS'
14707 ! include 'COMMON.CHAIN'
14708 ! include 'COMMON.INTERACT'
14709 ! include 'COMMON.VAR'
14710 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
14711 integer :: kkk,nsep=3
14712 real(kind=8) :: qm !dist,
14713 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
14714 logical :: lprn=.false.
14716 ! real(kind=8) :: sigm,x
14718 !el sigm(x)=0.25d0*x ! local function
14724 do il=seg1+nsep,seg2
14727 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
14728 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
14729 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
14731 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
14732 if (itype(il).ne.10 .or. itype(jl).ne.10) then
14735 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
14736 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
14737 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
14738 dijCM=dist(il+nres,jl+nres)
14739 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
14741 qq = qq+qqij+qqijCM
14747 if((seg3-il).lt.3) then
14754 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
14755 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
14756 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
14758 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
14759 if (itype(il).ne.10 .or. itype(jl).ne.10) then
14762 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
14763 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
14764 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
14765 dijCM=dist(il+nres,jl+nres)
14766 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
14768 qq = qq+qqij+qqijCM
14773 if (qqmax.le.qq) qqmax=qq
14775 qwolynes=1.0d0-qqmax
14777 end function qwolynes
14778 !-----------------------------------------------------------------------------
14779 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
14780 ! implicit real*8 (a-h,o-z)
14781 ! include 'DIMENSIONS'
14782 ! include 'COMMON.IOUNITS'
14783 ! include 'COMMON.CHAIN'
14784 ! include 'COMMON.INTERACT'
14785 ! include 'COMMON.VAR'
14786 ! include 'COMMON.MD'
14787 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
14788 integer :: nsep=3, kkk
14789 !el real(kind=8) :: dist
14790 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
14791 logical :: lprn=.false.
14793 real(kind=8) :: sim,dd0,fac,ddqij
14794 !el sigm(x)=0.25d0*x ! local function
14804 do il=seg1+nsep,seg2
14807 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
14808 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
14809 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
14811 sim = 1.0d0/sigm(d0ij)
14814 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
14816 ddqij = (c(k,il)-c(k,jl))*fac
14817 dqwol(k,il)=dqwol(k,il)+ddqij
14818 dqwol(k,jl)=dqwol(k,jl)-ddqij
14821 if (itype(il).ne.10 .or. itype(jl).ne.10) then
14824 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
14825 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
14826 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
14827 dijCM=dist(il+nres,jl+nres)
14828 sim = 1.0d0/sigm(d0ijCM)
14831 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
14833 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
14834 dxqwol(k,il)=dxqwol(k,il)+ddqij
14835 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
14842 if((seg3-il).lt.3) then
14849 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
14850 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
14851 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
14853 sim = 1.0d0/sigm(d0ij)
14856 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
14858 ddqij = (c(k,il)-c(k,jl))*fac
14859 dqwol(k,il)=dqwol(k,il)+ddqij
14860 dqwol(k,jl)=dqwol(k,jl)-ddqij
14862 if (itype(il).ne.10 .or. itype(jl).ne.10) then
14865 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
14866 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
14867 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
14868 dijCM=dist(il+nres,jl+nres)
14869 sim = 1.0d0/sigm(d0ijCM)
14872 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
14874 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
14875 dxqwol(k,il)=dxqwol(k,il)+ddqij
14876 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
14885 dqwol(j,i)=dqwol(j,i)/nl
14886 dxqwol(j,i)=dxqwol(j,i)/nl
14890 end subroutine qwolynes_prim
14891 !-----------------------------------------------------------------------------
14892 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
14893 ! implicit real*8 (a-h,o-z)
14894 ! include 'DIMENSIONS'
14895 ! include 'COMMON.IOUNITS'
14896 ! include 'COMMON.CHAIN'
14897 ! include 'COMMON.INTERACT'
14898 ! include 'COMMON.VAR'
14899 integer :: seg1,seg2,seg3,seg4
14901 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
14902 real(kind=8),dimension(3,0:2*nres) :: cdummy
14903 real(kind=8) :: q1,q2
14904 real(kind=8) :: delta=1.0d-10
14909 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
14911 c(j,i)=c(j,i)+delta
14912 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
14913 qwolan(j,i)=(q2-q1)/delta
14919 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
14920 cdummy(j,i+nres)=c(j,i+nres)
14921 c(j,i+nres)=c(j,i+nres)+delta
14922 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
14923 qwolxan(j,i)=(q2-q1)/delta
14924 c(j,i+nres)=cdummy(j,i+nres)
14927 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
14929 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
14931 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
14933 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
14936 end subroutine qwol_num
14937 !-----------------------------------------------------------------------------
14938 subroutine EconstrQ
14939 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
14940 ! implicit real*8 (a-h,o-z)
14941 ! include 'DIMENSIONS'
14942 ! include 'COMMON.CONTROL'
14943 ! include 'COMMON.VAR'
14944 ! include 'COMMON.MD'
14947 ! include 'COMMON.LANGEVIN'
14949 ! include 'COMMON.LANGEVIN.lang0'
14951 ! include 'COMMON.CHAIN'
14952 ! include 'COMMON.DERIV'
14953 ! include 'COMMON.GEO'
14954 ! include 'COMMON.LOCAL'
14955 ! include 'COMMON.INTERACT'
14956 ! include 'COMMON.IOUNITS'
14957 ! include 'COMMON.NAMES'
14958 ! include 'COMMON.TIME1'
14959 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
14960 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
14962 integer :: kstart,kend,lstart,lend,idummy
14963 real(kind=8) :: delta=1.0d-7
14964 integer :: i,j,k,ii
14968 dudconst(j,i)=0.0d0
14969 duxconst(j,i)=0.0d0
14970 dudxconst(j,i)=0.0d0
14975 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
14977 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
14978 ! Calculating the derivatives of Constraint energy with respect to Q
14979 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
14981 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
14982 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
14983 ! hmnum=(hm2-hm1)/delta
14984 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
14985 ! & qinfrag(i,iset))
14986 ! write(iout,*) "harmonicnum frag", hmnum
14987 ! Calculating the derivatives of Q with respect to cartesian coordinates
14988 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
14990 ! write(iout,*) "dqwol "
14992 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
14994 ! write(iout,*) "dxqwol "
14996 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
14998 ! Calculating numerical gradients of dU/dQi and dQi/dxi
14999 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
15000 ! & ,idummy,idummy)
15001 ! The gradients of Uconst in Cs
15004 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
15005 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
15010 kstart=ifrag(1,ipair(1,i,iset),iset)
15011 kend=ifrag(2,ipair(1,i,iset),iset)
15012 lstart=ifrag(1,ipair(2,i,iset),iset)
15013 lend=ifrag(2,ipair(2,i,iset),iset)
15014 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
15015 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
15016 ! Calculating dU/dQ
15017 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
15018 ! hm1=harmonic(qpair(i),qinpair(i,iset))
15019 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
15020 ! hmnum=(hm2-hm1)/delta
15021 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
15022 ! & qinpair(i,iset))
15023 ! write(iout,*) "harmonicnum pair ", hmnum
15024 ! Calculating dQ/dXi
15025 call qwolynes_prim(kstart,kend,.false.,&
15027 ! write(iout,*) "dqwol "
15029 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
15031 ! write(iout,*) "dxqwol "
15033 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
15035 ! Calculating numerical gradients
15036 ! call qwol_num(kstart,kend,.false.
15038 ! The gradients of Uconst in Cs
15041 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
15042 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
15046 ! write(iout,*) "Uconst inside subroutine ", Uconst
15047 ! Transforming the gradients from Cs to dCs for the backbone
15051 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
15055 ! Transforming the gradients from Cs to dCs for the side chains
15058 dudxconst(j,i)=duxconst(j,i)
15061 ! write(iout,*) "dU/ddc backbone "
15063 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
15065 ! write(iout,*) "dU/ddX side chain "
15067 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
15069 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
15070 ! call dEconstrQ_num
15072 end subroutine EconstrQ
15073 !-----------------------------------------------------------------------------
15074 subroutine dEconstrQ_num
15075 ! Calculating numerical dUconst/ddc and dUconst/ddx
15076 ! implicit real*8 (a-h,o-z)
15077 ! include 'DIMENSIONS'
15078 ! include 'COMMON.CONTROL'
15079 ! include 'COMMON.VAR'
15080 ! include 'COMMON.MD'
15083 ! include 'COMMON.LANGEVIN'
15085 ! include 'COMMON.LANGEVIN.lang0'
15087 ! include 'COMMON.CHAIN'
15088 ! include 'COMMON.DERIV'
15089 ! include 'COMMON.GEO'
15090 ! include 'COMMON.LOCAL'
15091 ! include 'COMMON.INTERACT'
15092 ! include 'COMMON.IOUNITS'
15093 ! include 'COMMON.NAMES'
15094 ! include 'COMMON.TIME1'
15095 real(kind=8) :: uzap1,uzap2
15096 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
15097 integer :: kstart,kend,lstart,lend,idummy
15098 real(kind=8) :: delta=1.0d-7
15099 !el local variables
15105 dUcartan(j,i)=0.0d0
15106 cdummy(j,i)=dc(j,i)
15107 dc(j,i)=dc(j,i)+delta
15108 call chainbuild_cart
15111 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15113 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
15117 kstart=ifrag(1,ipair(1,ii,iset),iset)
15118 kend=ifrag(2,ipair(1,ii,iset),iset)
15119 lstart=ifrag(1,ipair(2,ii,iset),iset)
15120 lend=ifrag(2,ipair(2,ii,iset),iset)
15121 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15122 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
15125 dc(j,i)=cdummy(j,i)
15126 call chainbuild_cart
15129 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15131 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
15135 kstart=ifrag(1,ipair(1,ii,iset),iset)
15136 kend=ifrag(2,ipair(1,ii,iset),iset)
15137 lstart=ifrag(1,ipair(2,ii,iset),iset)
15138 lend=ifrag(2,ipair(2,ii,iset),iset)
15139 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15140 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
15143 ducartan(j,i)=(uzap2-uzap1)/(delta)
15146 ! Calculating numerical gradients for dU/ddx
15148 duxcartan(j,i)=0.0d0
15150 cdummy(j,i)=dc(j,i+nres)
15151 dc(j,i+nres)=dc(j,i+nres)+delta
15152 call chainbuild_cart
15155 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15157 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
15161 kstart=ifrag(1,ipair(1,ii,iset),iset)
15162 kend=ifrag(2,ipair(1,ii,iset),iset)
15163 lstart=ifrag(1,ipair(2,ii,iset),iset)
15164 lend=ifrag(2,ipair(2,ii,iset),iset)
15165 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15166 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
15169 dc(j,i+nres)=cdummy(j,i)
15170 call chainbuild_cart
15173 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
15174 ifrag(2,ii,iset),.true.,idummy,idummy)
15175 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
15179 kstart=ifrag(1,ipair(1,ii,iset),iset)
15180 kend=ifrag(2,ipair(1,ii,iset),iset)
15181 lstart=ifrag(1,ipair(2,ii,iset),iset)
15182 lend=ifrag(2,ipair(2,ii,iset),iset)
15183 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15184 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
15187 duxcartan(j,i)=(uzap2-uzap1)/(delta)
15190 write(iout,*) "Numerical dUconst/ddc backbone "
15192 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
15194 ! write(iout,*) "Numerical dUconst/ddx side-chain "
15196 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
15199 end subroutine dEconstrQ_num
15200 !-----------------------------------------------------------------------------
15202 !-----------------------------------------------------------------------------
15203 subroutine check_energies
15205 ! use random, only: ran_number
15209 ! include 'DIMENSIONS'
15210 ! include 'COMMON.CHAIN'
15211 ! include 'COMMON.VAR'
15212 ! include 'COMMON.IOUNITS'
15213 ! include 'COMMON.SBRIDGE'
15214 ! include 'COMMON.LOCAL'
15215 ! include 'COMMON.GEO'
15217 ! External functions
15218 !EL double precision ran_number
15219 !EL external ran_number
15222 integer :: i,j,k,l,lmax,p,pmax
15223 real(kind=8) :: rmin,rmax
15224 real(kind=8) :: eij
15227 real(kind=8) :: wi,rij,tj,pj
15249 !t wi=ran_number(0.0D0,pi)
15250 ! wi=ran_number(0.0D0,pi/6.0D0)
15252 !t tj=ran_number(0.0D0,pi)
15253 !t pj=ran_number(0.0D0,pi)
15254 ! pj=ran_number(0.0D0,pi/6.0D0)
15258 !t rij=ran_number(rmin,rmax)
15260 c(1,j)=d*sin(pj)*cos(tj)
15261 c(2,j)=d*sin(pj)*sin(tj)
15267 c(3,i)=-rij-d*cos(wi)
15270 dc(k,nres+i)=c(k,nres+i)-c(k,i)
15271 dc_norm(k,nres+i)=dc(k,nres+i)/d
15272 dc(k,nres+j)=c(k,nres+j)-c(k,j)
15273 dc_norm(k,nres+j)=dc(k,nres+j)/d
15276 call dyn_ssbond_ene(i,j,eij)
15281 end subroutine check_energies
15282 !-----------------------------------------------------------------------------
15283 subroutine dyn_ssbond_ene(resi,resj,eij)
15288 ! include 'DIMENSIONS'
15289 ! include 'COMMON.SBRIDGE'
15290 ! include 'COMMON.CHAIN'
15291 ! include 'COMMON.DERIV'
15292 ! include 'COMMON.LOCAL'
15293 ! include 'COMMON.INTERACT'
15294 ! include 'COMMON.VAR'
15295 ! include 'COMMON.IOUNITS'
15296 ! include 'COMMON.CALC'
15300 ! include 'COMMON.MD'
15301 ! use MD, only: totT,t_bath
15304 ! External functions
15305 !EL double precision h_base
15306 !EL external h_base
15309 integer :: resi,resj
15312 real(kind=8) :: eij
15315 logical :: havebond
15316 integer itypi,itypj
15317 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
15318 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
15319 real(kind=8),dimension(3) :: dcosom1,dcosom2
15321 real(kind=8) :: pom1,pom2
15322 real(kind=8) :: ljA,ljB,ljXs
15323 real(kind=8),dimension(1:3) :: d_ljB
15324 real(kind=8) :: ssA,ssB,ssC,ssXs
15325 real(kind=8) :: ssxm,ljxm,ssm,ljm
15326 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
15327 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
15328 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
15329 !-------FIRST METHOD
15331 real(kind=8),dimension(1:3) :: d_xm
15332 !-------END FIRST METHOD
15333 !-------SECOND METHOD
15334 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
15335 !-------END SECOND METHOD
15337 !-------TESTING CODE
15338 !el logical :: checkstop,transgrad
15339 !el common /sschecks/ checkstop,transgrad
15341 integer :: icheck,nicheck,jcheck,njcheck
15342 real(kind=8),dimension(-1:1) :: echeck
15343 real(kind=8) :: deps,ssx0,ljx0
15344 !-------END TESTING CODE
15350 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
15351 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
15354 dxi=dc_norm(1,nres+i)
15355 dyi=dc_norm(2,nres+i)
15356 dzi=dc_norm(3,nres+i)
15357 dsci_inv=vbld_inv(i+nres)
15360 xj=c(1,nres+j)-c(1,nres+i)
15361 yj=c(2,nres+j)-c(2,nres+i)
15362 zj=c(3,nres+j)-c(3,nres+i)
15363 dxj=dc_norm(1,nres+j)
15364 dyj=dc_norm(2,nres+j)
15365 dzj=dc_norm(3,nres+j)
15366 dscj_inv=vbld_inv(j+nres)
15368 chi1=chi(itypi,itypj)
15369 chi2=chi(itypj,itypi)
15376 alf12=0.5D0*(alf1+alf2)
15378 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15379 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
15380 ! The following are set in sc_angular
15384 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
15385 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
15386 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
15388 rij=1.0D0/rij ! Reset this so it makes sense
15390 sig0ij=sigma(itypi,itypj)
15391 sig=sig0ij*dsqrt(1.0D0/sigsq)
15394 ljA=eps1*eps2rt**2*eps3rt**2
15395 ljB=ljA*bb(itypi,itypj)
15396 ljA=ljA*aa(itypi,itypj)
15397 ljxm=ljXs+(-2.0D0*aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
15402 deltat12=om2-om1+2.0d0
15403 cosphi=om12-om1*om2
15407 +akth*(deltat1*deltat1+deltat2*deltat2) &
15408 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
15409 ssxm=ssXs-0.5D0*ssB/ssA
15411 !-------TESTING CODE
15412 !$$$c Some extra output
15413 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
15414 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
15415 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
15416 !$$$ if (ssx0.gt.0.0d0) then
15417 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
15421 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
15422 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
15423 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
15425 !-------END TESTING CODE
15427 !-------TESTING CODE
15428 ! Stop and plot energy and derivative as a function of distance
15429 if (checkstop) then
15430 ssm=ssC-0.25D0*ssB*ssB/ssA
15431 ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
15432 if (ssm.lt.ljm .and. &
15433 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
15441 if (.not.checkstop) then
15446 do icheck=0,nicheck
15447 do jcheck=-1,njcheck
15448 if (checkstop) rij=(ssxm-1.0d0)+ &
15449 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
15450 !-------END TESTING CODE
15452 if (rij.gt.ljxm) then
15455 fac=(1.0D0/ljd)**expon
15456 e1=fac*fac*aa(itypi,itypj)
15457 e2=fac*bb(itypi,itypj)
15458 eij=eps1*eps2rt*eps3rt*(e1+e2)
15461 eij=eij*eps2rt*eps3rt
15464 e1=e1*eps1*eps2rt**2*eps3rt**2
15465 ed=-expon*(e1+eij)/ljd
15467 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
15468 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
15469 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
15470 -2.0D0*alf12*eps3der+sigder*sigsq_om12
15471 else if (rij.lt.ssxm) then
15474 eij=ssA*ssd*ssd+ssB*ssd+ssC
15476 ed=2*akcm*ssd+akct*deltat12
15478 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
15479 eom1=-2*akth*deltat1-pom1-om2*pom2
15480 eom2= 2*akth*deltat2+pom1-om1*pom2
15483 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
15485 d_ssxm(1)=0.5D0*akct/ssA
15486 d_ssxm(2)=-d_ssxm(1)
15489 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
15490 d_ljxm(2)=d_ljxm(1)*sigsq_om2
15491 d_ljxm(3)=d_ljxm(1)*sigsq_om12
15492 d_ljxm(1)=d_ljxm(1)*sigsq_om1
15494 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
15495 xm=0.5d0*(ssxm+ljxm)
15497 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
15499 if (rij.lt.xm) then
15501 ssm=ssC-0.25D0*ssB*ssB/ssA
15502 d_ssm(1)=0.5D0*akct*ssB/ssA
15503 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
15504 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
15506 f1=(rij-xm)/(ssxm-xm)
15507 f2=(rij-ssxm)/(xm-ssxm)
15511 delta_inv=1.0d0/(xm-ssxm)
15512 deltasq_inv=delta_inv*delta_inv
15514 fac1=deltasq_inv*fac*(xm-rij)
15515 fac2=deltasq_inv*fac*(rij-ssxm)
15516 ed=delta_inv*(Ht*hd2-ssm*hd1)
15517 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
15518 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
15519 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
15522 ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
15523 d_ljm(1)=-0.5D0*bb(itypi,itypj)/aa(itypi,itypj)*ljB
15524 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
15525 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
15527 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
15528 f1=(rij-ljxm)/(xm-ljxm)
15529 f2=(rij-xm)/(ljxm-xm)
15533 delta_inv=1.0d0/(ljxm-xm)
15534 deltasq_inv=delta_inv*delta_inv
15536 fac1=deltasq_inv*fac*(ljxm-rij)
15537 fac2=deltasq_inv*fac*(rij-xm)
15538 ed=delta_inv*(ljm*hd2-Ht*hd1)
15539 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
15540 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
15541 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
15543 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
15545 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
15551 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
15552 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
15553 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
15555 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
15556 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
15557 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
15558 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
15559 !$$$ d_ssm(3)=omega
15561 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
15563 !$$$ d_ljm(k)=ljm*d_ljB(k)
15567 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
15568 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
15569 !$$$ d_ss(2)=akct*ssd
15570 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
15571 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
15574 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
15575 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
15576 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
15578 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
15579 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
15581 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
15583 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
15584 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
15585 !$$$ h1=h_base(f1,hd1)
15586 !$$$ h2=h_base(f2,hd2)
15587 !$$$ eij=ss*h1+ljf*h2
15588 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
15589 !$$$ deltasq_inv=delta_inv*delta_inv
15590 !$$$ fac=ljf*hd2-ss*hd1
15591 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
15592 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
15593 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
15594 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
15595 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
15596 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
15597 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
15599 !$$$ havebond=.false.
15600 !$$$ if (ed.gt.0.0d0) havebond=.true.
15601 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
15608 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
15609 ! write(iout,'(a15,f12.2,f8.1,2i5)')
15610 ! & "SSBOND_E_FORM",totT,t_bath,i,j
15614 dyn_ssbond_ij(i,j)=eij
15615 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
15616 dyn_ssbond_ij(i,j)=1.0d300
15619 ! write(iout,'(a15,f12.2,f8.1,2i5)')
15620 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
15625 !-------TESTING CODE
15626 !el if (checkstop) then
15627 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
15628 "CHECKSTOP",rij,eij,ed
15632 if (checkstop) then
15633 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
15636 if (checkstop) then
15640 !-------END TESTING CODE
15643 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
15644 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
15647 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
15650 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
15651 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
15652 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
15653 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
15654 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
15655 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
15659 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
15664 gvdwc(l,i)=gvdwc(l,i)-gg(l)
15665 gvdwc(l,j)=gvdwc(l,j)+gg(l)
15669 end subroutine dyn_ssbond_ene
15670 !-----------------------------------------------------------------------------
15671 real(kind=8) function h_base(x,deriv)
15672 ! A smooth function going 0->1 in range [0,1]
15673 ! It should NOT be called outside range [0,1], it will not work there.
15680 real(kind=8) :: deriv
15683 real(kind=8) :: xsq
15686 ! Two parabolas put together. First derivative zero at extrema
15687 !$$$ if (x.lt.0.5D0) then
15688 !$$$ h_base=2.0D0*x*x
15692 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
15693 !$$$ deriv=4.0D0*deriv
15696 ! Third degree polynomial. First derivative zero at extrema
15697 h_base=x*x*(3.0d0-2.0d0*x)
15698 deriv=6.0d0*x*(1.0d0-x)
15700 ! Fifth degree polynomial. First and second derivatives zero at extrema
15702 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
15704 !$$$ deriv=deriv*deriv
15705 !$$$ deriv=30.0d0*xsq*deriv
15708 end function h_base
15709 !-----------------------------------------------------------------------------
15710 subroutine dyn_set_nss
15711 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
15713 use MD_data, only: totT,t_bath
15715 ! include 'DIMENSIONS'
15719 ! include 'COMMON.SBRIDGE'
15720 ! include 'COMMON.CHAIN'
15721 ! include 'COMMON.IOUNITS'
15722 ! include 'COMMON.SETUP'
15723 ! include 'COMMON.MD'
15725 real(kind=8) :: emin
15726 integer :: i,j,imin,ierr
15727 integer :: diff,allnss,newnss
15728 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
15731 integer,dimension(0:nfgtasks) :: i_newnss
15732 integer,dimension(0:nfgtasks) :: displ
15733 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
15734 integer :: g_newnss
15739 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
15748 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
15752 if (allflag(i).eq.0 .and. &
15753 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
15754 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
15758 if (emin.lt.1.0d300) then
15761 if (allflag(i).eq.0 .and. &
15762 (allihpb(i).eq.allihpb(imin) .or. &
15763 alljhpb(i).eq.allihpb(imin) .or. &
15764 allihpb(i).eq.alljhpb(imin) .or. &
15765 alljhpb(i).eq.alljhpb(imin))) then
15772 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
15776 if (allflag(i).eq.1) then
15778 newihpb(newnss)=allihpb(i)
15779 newjhpb(newnss)=alljhpb(i)
15784 if (nfgtasks.gt.1)then
15786 call MPI_Reduce(newnss,g_newnss,1,&
15787 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
15788 call MPI_Gather(newnss,1,MPI_INTEGER,&
15789 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
15791 do i=1,nfgtasks-1,1
15792 displ(i)=i_newnss(i-1)+displ(i-1)
15794 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
15795 g_newihpb,i_newnss,displ,MPI_INTEGER,&
15797 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
15798 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
15800 if(fg_rank.eq.0) then
15801 ! print *,'g_newnss',g_newnss
15802 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
15803 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
15806 newihpb(i)=g_newihpb(i)
15807 newjhpb(i)=g_newjhpb(i)
15815 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
15820 if (idssb(i).eq.newihpb(j) .and. &
15821 jdssb(i).eq.newjhpb(j)) found=.true.
15825 if (.not.found.and.fg_rank.eq.0) &
15826 write(iout,'(a15,f12.2,f8.1,2i5)') &
15827 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
15835 if (newihpb(i).eq.idssb(j) .and. &
15836 newjhpb(i).eq.jdssb(j)) found=.true.
15840 if (.not.found.and.fg_rank.eq.0) &
15841 write(iout,'(a15,f12.2,f8.1,2i5)') &
15842 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
15849 idssb(i)=newihpb(i)
15850 jdssb(i)=newjhpb(i)
15854 end subroutine dyn_set_nss
15855 !-----------------------------------------------------------------------------
15857 subroutine read_ssHist
15860 ! include 'DIMENSIONS'
15861 ! include "DIMENSIONS.FREE"
15862 ! include 'COMMON.FREE'
15865 character(len=80) :: controlcard
15868 call card_concat(controlcard,.true.)
15869 read(controlcard,*) &
15870 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
15874 end subroutine read_ssHist
15876 !-----------------------------------------------------------------------------
15877 integer function indmat(i,j)
15879 ! get the position of the jth ijth fragment of the chain coordinate system
15880 ! in the fromto array.
15883 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
15885 end function indmat
15886 !-----------------------------------------------------------------------------
15887 real(kind=8) function sigm(x)
15893 !-----------------------------------------------------------------------------
15894 !-----------------------------------------------------------------------------
15895 subroutine alloc_ener_arrays
15896 !EL Allocation of arrays used by module energy
15898 !el local variables
15901 if(nres.lt.100) then
15903 elseif(nres.lt.200) then
15904 maxconts=0.8*nres ! Max. number of contacts per residue
15906 maxconts=0.6*nres ! (maxconts=maxres/4)
15908 maxcont=12*nres ! Max. number of SC contacts
15909 maxvar=6*nres ! Max. number of variables
15910 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
15911 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
15912 !----------------------
15913 ! arrays in subroutine init_int_table
15915 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
15916 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
15918 allocate(nint_gr(nres))
15919 allocate(nscp_gr(nres))
15920 allocate(ielstart(nres))
15921 allocate(ielend(nres))
15923 allocate(istart(nres,maxint_gr))
15924 allocate(iend(nres,maxint_gr))
15925 !(maxres,maxint_gr)
15926 allocate(iscpstart(nres,maxint_gr))
15927 allocate(iscpend(nres,maxint_gr))
15928 !(maxres,maxint_gr)
15929 allocate(ielstart_vdw(nres))
15930 allocate(ielend_vdw(nres))
15933 allocate(lentyp(0:nfgtasks-1))
15935 !----------------------
15937 ! common /contacts/
15938 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
15939 allocate(icont(2,maxcont))
15941 ! common /contacts1/
15942 allocate(num_cont(0:nres+4))
15944 allocate(jcont(maxconts,nres))
15946 allocate(facont(maxconts,nres))
15948 allocate(gacont(3,maxconts,nres))
15949 !(3,maxconts,maxres)
15950 ! common /contacts_hb/
15951 allocate(gacontp_hb1(3,maxconts,nres))
15952 allocate(gacontp_hb2(3,maxconts,nres))
15953 allocate(gacontp_hb3(3,maxconts,nres))
15954 allocate(gacontm_hb1(3,maxconts,nres))
15955 allocate(gacontm_hb2(3,maxconts,nres))
15956 allocate(gacontm_hb3(3,maxconts,nres))
15957 allocate(gacont_hbr(3,maxconts,nres))
15958 allocate(grij_hb_cont(3,maxconts,nres))
15959 !(3,maxconts,maxres)
15960 allocate(facont_hb(maxconts,nres))
15961 allocate(ees0p(maxconts,nres))
15962 allocate(ees0m(maxconts,nres))
15963 allocate(d_cont(maxconts,nres))
15965 allocate(num_cont_hb(nres))
15967 allocate(jcont_hb(maxconts,nres))
15970 allocate(Ug(2,2,nres))
15971 allocate(Ugder(2,2,nres))
15972 allocate(Ug2(2,2,nres))
15973 allocate(Ug2der(2,2,nres))
15975 allocate(obrot(2,nres))
15976 allocate(obrot2(2,nres))
15977 allocate(obrot_der(2,nres))
15978 allocate(obrot2_der(2,nres))
15980 ! common /precomp1/
15981 allocate(mu(2,nres))
15982 allocate(muder(2,nres))
15983 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)
16173 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
16174 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
16175 allocate(dUdconst(3,0:nres))
16176 allocate(dUdxconst(3,0:nres))
16177 allocate(dqwol(3,0:nres))
16178 allocate(dxqwol(3,0:nres))
16180 !----------------------
16182 ! common /sbridge/ in io_common: read_bridge
16183 !el allocate((:),allocatable :: iss !(maxss)
16184 ! common /links/ in io_common: read_bridge
16185 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
16186 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
16187 ! common /dyn_ssbond/
16188 ! and side-chain vectors in theta or phi.
16189 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
16193 dyn_ssbond_ij(i,j)=1.0d300
16198 allocate(idssb(nss),jdssb(nss))
16201 allocate(dyn_ss_mask(nres))
16204 dyn_ss_mask(i)=.false.
16206 !----------------------
16208 ! Parameters of the SCCOR term
16210 !el in io_conf: parmread
16211 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
16212 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
16213 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
16214 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
16215 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
16216 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
16217 ! allocate(vlor1sccor(maxterm_sccor,20,20))
16218 ! allocate(vlor2sccor(maxterm_sccor,20,20))
16219 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
16221 allocate(gloc_sc(3,0:2*nres,0:10))
16222 !(3,0:maxres2,10)maxres2=2*maxres
16223 allocate(dcostau(3,3,3,2*nres))
16224 allocate(dsintau(3,3,3,2*nres))
16225 allocate(dtauangle(3,3,3,2*nres))
16226 allocate(dcosomicron(3,3,3,2*nres))
16227 allocate(domicron(3,3,3,2*nres))
16228 !(3,3,3,maxres2)maxres2=2*maxres
16229 !----------------------
16232 allocate(varall(maxvar))
16233 !(maxvar)(maxvar=6*maxres)
16234 allocate(mask_theta(nres))
16235 allocate(mask_phi(nres))
16236 allocate(mask_side(nres))
16238 !----------------------
16241 allocate(uy(3,nres))
16242 allocate(uz(3,nres))
16244 allocate(uygrad(3,3,2,nres))
16245 allocate(uzgrad(3,3,2,nres))
16249 end subroutine alloc_ener_arrays
16250 !-----------------------------------------------------------------------------
16251 !-----------------------------------------------------------------------------