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'
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 ! shielding effect varibles for MPI
217 ! real(kind=8) fac_shieldbuf(maxres),
218 ! & grad_shield_locbuf(3,maxcontsshi,-1:maxres),
219 ! & grad_shield_sidebuf(3,maxcontsshi,-1:maxres),
220 ! & grad_shieldbuf(3,-1:maxres)
221 ! integer ishield_listbuf(maxres),
222 ! &shield_listbuf(maxcontsshi,maxres)
224 ! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
225 ! & " nfgtasks",nfgtasks
226 if (nfgtasks.gt.1) then
228 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
229 if (fg_rank.eq.0) then
230 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
231 ! print *,"Processor",myrank," BROADCAST iorder"
232 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
233 ! FG slaves as WEIGHTS array.
253 ! FG Master broadcasts the WEIGHTS_ array
254 call MPI_Bcast(weights_(1),n_ene,&
255 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
257 ! FG slaves receive the WEIGHTS array
258 call MPI_Bcast(weights(1),n_ene,&
259 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
280 time_Bcast=time_Bcast+MPI_Wtime()-time00
281 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
282 ! call chainbuild_cart
284 ! print *,'Processor',myrank,' calling etotal ipot=',ipot
285 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
287 ! if (modecalc.eq.12.or.modecalc.eq.14) then
288 ! call int_from_cart1(.false.)
295 ! Compute the side-chain and electrostatic interaction energy
297 ! goto (101,102,103,104,105,106) ipot
299 ! Lennard-Jones potential.
303 !d print '(a)','Exit ELJcall el'
305 ! Lennard-Jones-Kihara potential (shifted).
306 ! 102 call eljk(evdw)
310 ! Berne-Pechukas potential (dilated LJ, angular dependence).
315 ! Gay-Berne potential (shifted LJ, angular dependence).
320 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
321 ! 105 call egbv(evdw)
325 ! Soft-sphere potential
326 ! 106 call e_softsphere(evdw)
328 call e_softsphere(evdw)
330 ! Calculate electrostatic (H-bonding) energy of the main chain.
334 write(iout,*)"Wrong ipot"
341 !mc Sep-06: egb takes care of dynamic ss bonds too
343 ! if (dyn_ss) call dyn_set_nss
344 ! print *,"Processor",myrank," computed USCSC"
350 time_vec=time_vec+MPI_Wtime()-time01
352 ! print *,"Processor",myrank," left VEC_AND_DERIV"
355 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
356 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
357 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
358 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
360 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
361 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
362 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
363 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
365 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
366 ! write (iout,*) "ELEC calc"
375 ! write (iout,*) "Soft-spheer ELEC potential"
376 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
379 ! print *,"Processor",myrank," computed UELEC"
381 ! Calculate excluded-volume interaction energy between peptide groups
384 !elwrite(iout,*) "in etotal calc exc;luded",ipot
388 call escp(evdw2,evdw2_14)
394 ! write (iout,*) "Soft-sphere SCP potential"
395 call escp_soft_sphere(evdw2,evdw2_14)
397 !elwrite(iout,*) "in etotal before ebond",ipot
400 ! Calculate the bond-stretching energy
403 !elwrite(iout,*) "in etotal afer ebond",ipot
406 ! Calculate the disulfide-bridge and other energy and the contributions
407 ! from other distance constraints.
408 ! print *,'Calling EHPB'
410 !elwrite(iout,*) "in etotal afer edis",ipot
411 ! print *,'EHPB exitted succesfully.'
413 ! Calculate the virtual-bond-angle energy.
415 if (wang.gt.0d0) then
420 ! print *,"Processor",myrank," computed UB"
422 ! Calculate the SC local energy.
425 !elwrite(iout,*) "in etotal afer esc",ipot
426 ! print *,"Processor",myrank," computed USC"
428 ! Calculate the virtual-bond torsional energy.
430 !d print *,'nterm=',nterm
432 call etor(etors,edihcnstr)
437 ! print *,"Processor",myrank," computed Utor"
439 ! 6/23/01 Calculate double-torsional energy
441 !elwrite(iout,*) "in etotal",ipot
442 if (wtor_d.gt.0) then
447 ! print *,"Processor",myrank," computed Utord"
449 ! 21/5/07 Calculate local sicdechain correlation energy
451 if (wsccor.gt.0.0d0) then
452 call eback_sc_corr(esccor)
456 ! print *,"Processor",myrank," computed Usccorr"
458 ! 12/1/95 Multi-body terms
462 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
463 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
464 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
465 !d write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
466 !d &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
473 !elwrite(iout,*) "in etotal",ipot
474 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
475 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
476 !d write (iout,*) "multibody_hb ecorr",ecorr
478 !elwrite(iout,*) "afeter multibody hb"
480 ! print *,"Processor",myrank," computed Ucorr"
482 ! If performing constraint dynamics, call the constraint energy
483 ! after the equilibration time
484 if(usampl.and.totT.gt.eq_time) then
485 !elwrite(iout,*) "afeter multibody hb"
487 !elwrite(iout,*) "afeter multibody hb"
489 !elwrite(iout,*) "afeter multibody hb"
494 !elwrite(iout,*) "after Econstr"
497 time_enecalc=time_enecalc+MPI_Wtime()-time00
499 ! print *,"Processor",myrank," computed Uconstr"
508 energia(2)=evdw2-evdw2_14
525 energia(8)=eello_turn3
526 energia(9)=eello_turn4
533 energia(19)=edihcnstr
535 energia(20)=Uconst+Uconst_back
537 ! Here are the energies showed per procesor if the are more processors
538 ! per molecule then we sum it up in sum_energy subroutine
539 ! print *," Processor",myrank," calls SUM_ENERGY"
540 call sum_energy(energia,.true.)
541 if (dyn_ss) call dyn_set_nss
542 ! print *," Processor",myrank," left SUM_ENERGY"
544 time_sumene=time_sumene+MPI_Wtime()-time00
546 !el call enerprint(energia)
547 !elwrite(iout,*)"finish etotal"
549 end subroutine etotal
550 !-----------------------------------------------------------------------------
551 subroutine sum_energy(energia,reduce)
552 ! implicit real*8 (a-h,o-z)
553 ! include 'DIMENSIONS'
557 !MS$ATTRIBUTES C :: proc_proc
563 ! include 'COMMON.SETUP'
564 ! include 'COMMON.IOUNITS'
565 real(kind=8) :: energia(0:n_ene),enebuff(0:n_ene+1)
566 ! include 'COMMON.FFIELD'
567 ! include 'COMMON.DERIV'
568 ! include 'COMMON.INTERACT'
569 ! include 'COMMON.SBRIDGE'
570 ! include 'COMMON.CHAIN'
571 ! include 'COMMON.VAR'
572 ! include 'COMMON.CONTROL'
573 ! include 'COMMON.TIME1'
575 real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
576 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
577 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot
581 real(kind=8) :: time00
582 if (nfgtasks.gt.1 .and. reduce) then
585 write (iout,*) "energies before REDUCE"
586 call enerprint(energia)
590 enebuff(i)=energia(i)
593 call MPI_Barrier(FG_COMM,IERR)
594 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
596 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,&
597 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
599 write (iout,*) "energies after REDUCE"
600 call enerprint(energia)
603 time_Reduce=time_Reduce+MPI_Wtime()-time00
605 if (fg_rank.eq.0) then
609 evdw2=energia(2)+energia(18)
625 eello_turn3=energia(8)
626 eello_turn4=energia(9)
633 edihcnstr=energia(19)
638 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
639 +wang*ebe+wtor*etors+wscloc*escloc &
640 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
641 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
642 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
643 +wbond*estr+Uconst+wsccor*esccor
645 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
646 +wang*ebe+wtor*etors+wscloc*escloc &
647 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
648 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
649 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
650 +wbond*estr+Uconst+wsccor*esccor
656 if (isnan(etot).ne.0) energia(0)=1.0d+99
658 if (isnan(etot)) energia(0)=1.0d+99
663 idumm=proc_proc(etot,i)
665 call proc_proc(etot,i)
667 if(i.eq.1)energia(0)=1.0d+99
672 ! call enerprint(energia)
675 end subroutine sum_energy
676 !-----------------------------------------------------------------------------
677 subroutine rescale_weights(t_bath)
678 ! implicit real*8 (a-h,o-z)
682 ! include 'DIMENSIONS'
683 ! include 'COMMON.IOUNITS'
684 ! include 'COMMON.FFIELD'
685 ! include 'COMMON.SBRIDGE'
686 real(kind=8) :: kfac=2.4d0
687 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644
689 real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6
690 real(kind=8) :: T0=3.0d2
693 ! facT=2*temp0/(t_bath+temp0)
694 if (rescale_mode.eq.0) then
701 else if (rescale_mode.eq.1) then
702 facT(1)=kfac/(kfac-1.0d0+t_bath/temp0)
703 facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
704 facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
705 facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
706 facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
708 !#if defined(WHAM_RUN) || defined(CLUSTER)
710 ! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
711 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
718 else if (rescale_mode.eq.2) then
724 facT(1)=licznik/dlog(dexp(x)+dexp(-x))
725 facT(2)=licznik/dlog(dexp(x2)+dexp(-x2))
726 facT(3)=licznik/dlog(dexp(x3)+dexp(-x3))
727 facT(4)=licznik/dlog(dexp(x4)+dexp(-x4))
728 facT(5)=licznik/dlog(dexp(x5)+dexp(-x5))
730 !#if defined(WHAM_RUN) || defined(CLUSTER)
732 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
740 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
741 write (*,*) "Wrong RESCALE_MODE",rescale_mode
743 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
747 welec=weights(3)*fact(1)
748 wcorr=weights(4)*fact(3)
749 wcorr5=weights(5)*fact(4)
750 wcorr6=weights(6)*fact(5)
751 wel_loc=weights(7)*fact(2)
752 wturn3=weights(8)*fact(2)
753 wturn4=weights(9)*fact(3)
754 wturn6=weights(10)*fact(5)
755 wtor=weights(13)*fact(1)
756 wtor_d=weights(14)*fact(2)
757 wsccor=weights(21)*fact(1)
760 end subroutine rescale_weights
761 !-----------------------------------------------------------------------------
762 subroutine enerprint(energia)
763 ! implicit real*8 (a-h,o-z)
764 ! include 'DIMENSIONS'
765 ! include 'COMMON.IOUNITS'
766 ! include 'COMMON.FFIELD'
767 ! include 'COMMON.SBRIDGE'
768 ! include 'COMMON.MD'
769 real(kind=8) :: energia(0:n_ene)
771 real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
772 real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
773 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor
779 evdw2=energia(2)+energia(18)
791 eello_turn3=energia(8)
792 eello_turn4=energia(9)
793 eello_turn6=energia(10)
799 edihcnstr=energia(19)
804 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
805 estr,wbond,ebe,wang,&
806 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
808 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
809 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,&
812 10 format (/'Virtual-chain energies:'// &
813 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
814 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
815 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
816 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ &
817 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
818 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
819 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
820 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
821 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
822 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
823 ' (SS bridges & dist. cnstr.)'/ &
824 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
825 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
826 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
827 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
828 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
829 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
830 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
831 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
832 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
833 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
834 'UCONST= ',1pE16.6,' (Constraint energy)'/ &
835 'ETOT= ',1pE16.6,' (total)')
837 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
838 estr,wbond,ebe,wang,&
839 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
841 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
842 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
844 10 format (/'Virtual-chain energies:'// &
845 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
846 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
847 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
848 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
849 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
850 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
851 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
852 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
853 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
854 ' (SS bridges & dist. cnstr.)'/ &
855 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
856 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
857 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
858 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
859 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
860 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
861 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
862 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
863 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
864 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
865 'UCONST=',1pE16.6,' (Constraint energy)'/ &
866 'ETOT= ',1pE16.6,' (total)')
869 end subroutine enerprint
870 !-----------------------------------------------------------------------------
873 ! This subroutine calculates the interaction energy of nonbonded side chains
874 ! assuming the LJ potential of interaction.
876 ! implicit real*8 (a-h,o-z)
877 ! include 'DIMENSIONS'
878 real(kind=8),parameter :: accur=1.0d-10
879 ! include 'COMMON.GEO'
880 ! include 'COMMON.VAR'
881 ! include 'COMMON.LOCAL'
882 ! include 'COMMON.CHAIN'
883 ! include 'COMMON.DERIV'
884 ! include 'COMMON.INTERACT'
885 ! include 'COMMON.TORSION'
886 ! include 'COMMON.SBRIDGE'
887 ! include 'COMMON.NAMES'
888 ! include 'COMMON.IOUNITS'
889 ! include 'COMMON.CONTACTS'
890 real(kind=8),dimension(3) :: gg
893 integer :: i,itypi,iint,j,itypi1,itypj,k
894 real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
895 real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
896 real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
898 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
900 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
901 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
902 ! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
903 ! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
907 if (itypi.eq.ntyp1) cycle
908 itypi1=iabs(itype(i+1))
915 ! Calculate SC interaction energy.
918 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
919 !d & 'iend=',iend(i,iint)
920 do j=istart(i,iint),iend(i,iint)
922 if (itypj.eq.ntyp1) cycle
926 ! Change 12/1/95 to calculate four-body interactions
927 rij=xj*xj+yj*yj+zj*zj
929 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
930 eps0ij=eps(itypi,itypj)
932 e1=fac*fac*aa(itypi,itypj)
933 e2=fac*bb(itypi,itypj)
935 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
936 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
937 !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
938 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
939 !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
940 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
943 ! Calculate the components of the gradient in DC and X
945 fac=-rrij*(e1+evdwij)
950 gvdwx(k,i)=gvdwx(k,i)-gg(k)
951 gvdwx(k,j)=gvdwx(k,j)+gg(k)
952 gvdwc(k,i)=gvdwc(k,i)-gg(k)
953 gvdwc(k,j)=gvdwc(k,j)+gg(k)
957 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
961 ! 12/1/95, revised on 5/20/97
963 ! Calculate the contact function. The ith column of the array JCONT will
964 ! contain the numbers of atoms that make contacts with the atom I (of numbers
965 ! greater than I). The arrays FACONT and GACONT will contain the values of
966 ! the contact function and its derivative.
968 ! Uncomment next line, if the correlation interactions include EVDW explicitly.
969 ! if (j.gt.i+1 .and. evdwij.le.0.0D0) then
970 ! Uncomment next line, if the correlation interactions are contact function only
971 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
973 sigij=sigma(itypi,itypj)
974 r0ij=rs0(itypi,itypj)
976 ! Check whether the SC's are not too far to make a contact.
979 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
980 ! Add a new contact, if the SC's are close enough, but not too close (r<sigma).
982 if (fcont.gt.0.0D0) then
983 ! If the SC-SC distance if close to sigma, apply spline.
984 !Adam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
985 !Adam & fcont1,fprimcont1)
986 !Adam fcont1=1.0d0-fcont1
987 !Adam if (fcont1.gt.0.0d0) then
988 !Adam fprimcont=fprimcont*fcont1+fcont*fprimcont1
989 !Adam fcont=fcont*fcont1
991 ! Uncomment following 4 lines to have the geometric average of the epsilon0's
992 !ga eps0ij=1.0d0/dsqrt(eps0ij)
994 !ga gg(k)=gg(k)*eps0ij
996 !ga eps0ij=-evdwij*eps0ij
997 ! Uncomment for AL's type of SC correlation interactions.
999 num_conti=num_conti+1
1000 jcont(num_conti,i)=j
1001 facont(num_conti,i)=fcont*eps0ij
1002 fprimcont=eps0ij*fprimcont/rij
1004 !Adam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1005 !Adam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1006 !Adam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1007 ! Uncomment following 3 lines for Skolnick's type of SC correlation.
1008 gacont(1,num_conti,i)=-fprimcont*xj
1009 gacont(2,num_conti,i)=-fprimcont*yj
1010 gacont(3,num_conti,i)=-fprimcont*zj
1011 !d write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1012 !d write (iout,'(2i3,3f10.5)')
1013 !d & i,j,(gacont(kk,num_conti,i),kk=1,3)
1019 num_cont(i)=num_conti
1023 gvdwc(j,i)=expon*gvdwc(j,i)
1024 gvdwx(j,i)=expon*gvdwx(j,i)
1027 !******************************************************************************
1031 ! To save time, the factor of EXPON has been extracted from ALL components
1032 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
1035 !******************************************************************************
1038 !-----------------------------------------------------------------------------
1039 subroutine eljk(evdw)
1041 ! This subroutine calculates the interaction energy of nonbonded side chains
1042 ! assuming the LJK potential of interaction.
1044 ! implicit real*8 (a-h,o-z)
1045 ! include 'DIMENSIONS'
1046 ! include 'COMMON.GEO'
1047 ! include 'COMMON.VAR'
1048 ! include 'COMMON.LOCAL'
1049 ! include 'COMMON.CHAIN'
1050 ! include 'COMMON.DERIV'
1051 ! include 'COMMON.INTERACT'
1052 ! include 'COMMON.IOUNITS'
1053 ! include 'COMMON.NAMES'
1054 real(kind=8),dimension(3) :: gg
1057 integer :: i,iint,j,itypi,itypi1,k,itypj
1058 real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
1059 real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
1061 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1063 do i=iatsc_s,iatsc_e
1064 itypi=iabs(itype(i))
1065 if (itypi.eq.ntyp1) cycle
1066 itypi1=iabs(itype(i+1))
1071 ! Calculate SC interaction energy.
1073 do iint=1,nint_gr(i)
1074 do j=istart(i,iint),iend(i,iint)
1075 itypj=iabs(itype(j))
1076 if (itypj.eq.ntyp1) cycle
1080 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1081 fac_augm=rrij**expon
1082 e_augm=augm(itypi,itypj)*fac_augm
1083 r_inv_ij=dsqrt(rrij)
1085 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1086 fac=r_shift_inv**expon
1087 e1=fac*fac*aa(itypi,itypj)
1088 e2=fac*bb(itypi,itypj)
1090 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1091 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1092 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1093 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1094 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1095 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1096 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1099 ! Calculate the components of the gradient in DC and X
1101 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1106 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1107 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1108 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1109 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1113 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1121 gvdwc(j,i)=expon*gvdwc(j,i)
1122 gvdwx(j,i)=expon*gvdwx(j,i)
1127 !-----------------------------------------------------------------------------
1128 subroutine ebp(evdw)
1130 ! This subroutine calculates the interaction energy of nonbonded side chains
1131 ! assuming the Berne-Pechukas potential of interaction.
1135 ! implicit real*8 (a-h,o-z)
1136 ! include 'DIMENSIONS'
1137 ! include 'COMMON.GEO'
1138 ! include 'COMMON.VAR'
1139 ! include 'COMMON.LOCAL'
1140 ! include 'COMMON.CHAIN'
1141 ! include 'COMMON.DERIV'
1142 ! include 'COMMON.NAMES'
1143 ! include 'COMMON.INTERACT'
1144 ! include 'COMMON.IOUNITS'
1145 ! include 'COMMON.CALC'
1147 !el integer :: icall
1148 !el common /srutu/ icall
1149 ! double precision rrsave(maxdim)
1152 integer :: iint,itypi,itypi1,itypj
1153 real(kind=8) :: rrij,xi,yi,zi
1154 real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
1156 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1158 ! if (icall.eq.0) then
1164 do i=iatsc_s,iatsc_e
1165 itypi=iabs(itype(i))
1166 if (itypi.eq.ntyp1) cycle
1167 itypi1=iabs(itype(i+1))
1171 dxi=dc_norm(1,nres+i)
1172 dyi=dc_norm(2,nres+i)
1173 dzi=dc_norm(3,nres+i)
1174 ! dsci_inv=dsc_inv(itypi)
1175 dsci_inv=vbld_inv(i+nres)
1177 ! Calculate SC interaction energy.
1179 do iint=1,nint_gr(i)
1180 do j=istart(i,iint),iend(i,iint)
1182 itypj=iabs(itype(j))
1183 if (itypj.eq.ntyp1) cycle
1184 ! dscj_inv=dsc_inv(itypj)
1185 dscj_inv=vbld_inv(j+nres)
1186 chi1=chi(itypi,itypj)
1187 chi2=chi(itypj,itypi)
1194 alf12=0.5D0*(alf1+alf2)
1195 ! For diagnostics only!!!
1208 dxj=dc_norm(1,nres+j)
1209 dyj=dc_norm(2,nres+j)
1210 dzj=dc_norm(3,nres+j)
1211 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1212 !d if (icall.eq.0) then
1218 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
1220 ! Calculate whole angle-dependent part of epsilon and contributions
1221 ! to its derivatives
1222 fac=(rrij*sigsq)**expon2
1223 e1=fac*fac*aa(itypi,itypj)
1224 e2=fac*bb(itypi,itypj)
1225 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1226 eps2der=evdwij*eps3rt
1227 eps3der=evdwij*eps2rt
1228 evdwij=evdwij*eps2rt*eps3rt
1231 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1232 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1233 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1234 !d & restyp(itypi),i,restyp(itypj),j,
1235 !d & epsi,sigm,chi1,chi2,chip1,chip2,
1236 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1237 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
1240 ! Calculate gradient components.
1241 e1=e1*eps1*eps2rt**2*eps3rt**2
1242 fac=-expon*(e1+evdwij)
1245 ! Calculate radial part of the gradient
1249 ! Calculate the angular part of the gradient and sum add the contributions
1250 ! to the appropriate components of the Cartesian gradient.
1258 !-----------------------------------------------------------------------------
1259 subroutine egb(evdw)
1261 ! This subroutine calculates the interaction energy of nonbonded side chains
1262 ! assuming the Gay-Berne potential of interaction.
1265 ! implicit real*8 (a-h,o-z)
1266 ! include 'DIMENSIONS'
1267 ! include 'COMMON.GEO'
1268 ! include 'COMMON.VAR'
1269 ! include 'COMMON.LOCAL'
1270 ! include 'COMMON.CHAIN'
1271 ! include 'COMMON.DERIV'
1272 ! include 'COMMON.NAMES'
1273 ! include 'COMMON.INTERACT'
1274 ! include 'COMMON.IOUNITS'
1275 ! include 'COMMON.CALC'
1276 ! include 'COMMON.CONTROL'
1277 ! include 'COMMON.SBRIDGE'
1280 integer :: iint,itypi,itypi1,itypj,subchap
1281 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
1282 real(kind=8) :: evdw,sig0ij
1283 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
1284 dist_temp, dist_init
1286 !cccc energy_dec=.false.
1287 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1290 ! if (icall.eq.0) lprn=.false.
1292 do i=iatsc_s,iatsc_e
1293 itypi=iabs(itype(i))
1294 if (itypi.eq.ntyp1) cycle
1295 itypi1=iabs(itype(i+1))
1299 xi=dmod(xi,boxxsize)
1300 if (xi.lt.0) xi=xi+boxxsize
1301 yi=dmod(yi,boxysize)
1302 if (yi.lt.0) yi=yi+boxysize
1303 zi=dmod(zi,boxzsize)
1304 if (zi.lt.0) zi=zi+boxzsize
1306 dxi=dc_norm(1,nres+i)
1307 dyi=dc_norm(2,nres+i)
1308 dzi=dc_norm(3,nres+i)
1309 ! dsci_inv=dsc_inv(itypi)
1310 dsci_inv=vbld_inv(i+nres)
1311 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1312 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1314 ! Calculate SC interaction energy.
1316 do iint=1,nint_gr(i)
1317 do j=istart(i,iint),iend(i,iint)
1318 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1319 call dyn_ssbond_ene(i,j,evdwij)
1321 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1322 'evdw',i,j,evdwij,' ss'
1323 ! if (energy_dec) write (iout,*) &
1324 ! 'evdw',i,j,evdwij,' ss'
1327 itypj=iabs(itype(j))
1328 if (itypj.eq.ntyp1) cycle
1329 ! dscj_inv=dsc_inv(itypj)
1330 dscj_inv=vbld_inv(j+nres)
1331 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,&
1332 ! 1.0d0/vbld(j+nres) !d
1333 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1334 sig0ij=sigma(itypi,itypj)
1335 chi1=chi(itypi,itypj)
1336 chi2=chi(itypj,itypi)
1343 alf12=0.5D0*(alf1+alf2)
1344 ! For diagnostics only!!!
1357 xj=dmod(xj,boxxsize)
1358 if (xj.lt.0) xj=xj+boxxsize
1359 yj=dmod(yj,boxysize)
1360 if (yj.lt.0) yj=yj+boxysize
1361 zj=dmod(zj,boxzsize)
1362 if (zj.lt.0) zj=zj+boxzsize
1363 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1371 xj=xj_safe+xshift*boxxsize
1372 yj=yj_safe+yshift*boxysize
1373 zj=zj_safe+zshift*boxzsize
1374 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1375 if(dist_temp.lt.dist_init) then
1385 if (subchap.eq.1) then
1394 dxj=dc_norm(1,nres+j)
1395 dyj=dc_norm(2,nres+j)
1396 dzj=dc_norm(3,nres+j)
1397 ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1398 ! write (iout,*) "j",j," dc_norm",& !d
1399 ! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1400 ! write(iout,*)"rrij ",rrij
1401 ! write(iout,*)"xj yj zj ", xj, yj, zj
1402 ! write(iout,*)"xi yi zi ", xi, yi, zi
1403 ! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
1404 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1406 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
1407 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
1408 ! print *,sss_ele_cut,sss_ele_grad,&
1409 ! 1.0d0/(rij),r_cut_ele,rlamb_ele
1410 if (sss_ele_cut.le.0.0) cycle
1411 ! Calculate angle-dependent terms of energy and contributions to their
1415 sig=sig0ij*dsqrt(sigsq)
1416 rij_shift=1.0D0/rij-sig+sig0ij
1417 ! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,&
1419 ! for diagnostics; uncomment
1420 ! rij_shift=1.2*sig0ij
1421 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1422 if (rij_shift.le.0.0D0) then
1424 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1425 !d & restyp(itypi),i,restyp(itypj),j,
1426 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1430 !---------------------------------------------------------------
1431 rij_shift=1.0D0/rij_shift
1432 fac=rij_shift**expon
1433 e1=fac*fac*aa(itypi,itypj)
1434 e2=fac*bb(itypi,itypj)
1435 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1436 eps2der=evdwij*eps3rt
1437 eps3der=evdwij*eps2rt
1438 ! write(iout,*)"aa, bb ",aa(:,:),bb(:,:)
1439 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d
1440 ! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d
1441 evdwij=evdwij*eps2rt*eps3rt
1442 evdw=evdw+evdwij*sss_ele_cut
1444 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1445 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1446 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1447 restyp(itypi),i,restyp(itypj),j, &
1448 epsi,sigm,chi1,chi2,chip1,chip2, &
1449 eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
1450 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
1454 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
1455 'evdw',i,j,evdwij !,"egb"
1456 ! if (energy_dec) write (iout,*) &
1459 ! Calculate gradient components.
1460 e1=e1*eps1*eps2rt**2*eps3rt**2
1461 fac=-expon*(e1+evdwij)*rij_shift
1464 ! print *,'before fac',fac,rij,evdwij
1465 fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
1466 /sigma(itypi,itypj)*rij
1467 ! print *,'grad part scale',fac, &
1468 ! evdwij*sss_ele_grad/sss_ele_cut &
1469 ! /sigma(itypi,itypj)*rij
1471 ! Calculate the radial part of the gradient
1475 ! print *,'before sc_grad', gg(1),gg(2),gg(3)
1476 ! Calculate angular part of the gradient.
1482 ! write (iout,*) "Number of loop steps in EGB:",ind
1483 !ccc energy_dec=.false.
1486 !-----------------------------------------------------------------------------
1487 subroutine egbv(evdw)
1489 ! This subroutine calculates the interaction energy of nonbonded side chains
1490 ! assuming the Gay-Berne-Vorobjev potential of interaction.
1494 ! implicit real*8 (a-h,o-z)
1495 ! include 'DIMENSIONS'
1496 ! include 'COMMON.GEO'
1497 ! include 'COMMON.VAR'
1498 ! include 'COMMON.LOCAL'
1499 ! include 'COMMON.CHAIN'
1500 ! include 'COMMON.DERIV'
1501 ! include 'COMMON.NAMES'
1502 ! include 'COMMON.INTERACT'
1503 ! include 'COMMON.IOUNITS'
1504 ! include 'COMMON.CALC'
1506 !el integer :: icall
1507 !el common /srutu/ icall
1510 integer :: iint,itypi,itypi1,itypj
1511 real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
1512 real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
1514 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1517 ! if (icall.eq.0) lprn=.true.
1519 do i=iatsc_s,iatsc_e
1520 itypi=iabs(itype(i))
1521 if (itypi.eq.ntyp1) cycle
1522 itypi1=iabs(itype(i+1))
1526 dxi=dc_norm(1,nres+i)
1527 dyi=dc_norm(2,nres+i)
1528 dzi=dc_norm(3,nres+i)
1529 ! dsci_inv=dsc_inv(itypi)
1530 dsci_inv=vbld_inv(i+nres)
1532 ! Calculate SC interaction energy.
1534 do iint=1,nint_gr(i)
1535 do j=istart(i,iint),iend(i,iint)
1537 itypj=iabs(itype(j))
1538 if (itypj.eq.ntyp1) cycle
1539 ! dscj_inv=dsc_inv(itypj)
1540 dscj_inv=vbld_inv(j+nres)
1541 sig0ij=sigma(itypi,itypj)
1542 r0ij=r0(itypi,itypj)
1543 chi1=chi(itypi,itypj)
1544 chi2=chi(itypj,itypi)
1551 alf12=0.5D0*(alf1+alf2)
1552 ! For diagnostics only!!!
1565 dxj=dc_norm(1,nres+j)
1566 dyj=dc_norm(2,nres+j)
1567 dzj=dc_norm(3,nres+j)
1568 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1570 ! Calculate angle-dependent terms of energy and contributions to their
1574 sig=sig0ij*dsqrt(sigsq)
1575 rij_shift=1.0D0/rij-sig+r0ij
1576 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1577 if (rij_shift.le.0.0D0) then
1582 !---------------------------------------------------------------
1583 rij_shift=1.0D0/rij_shift
1584 fac=rij_shift**expon
1585 e1=fac*fac*aa(itypi,itypj)
1586 e2=fac*bb(itypi,itypj)
1587 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1588 eps2der=evdwij*eps3rt
1589 eps3der=evdwij*eps2rt
1590 fac_augm=rrij**expon
1591 e_augm=augm(itypi,itypj)*fac_augm
1592 evdwij=evdwij*eps2rt*eps3rt
1593 evdw=evdw+evdwij+e_augm
1595 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1596 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1597 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1598 restyp(itypi),i,restyp(itypj),j,&
1599 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
1600 chi1,chi2,chip1,chip2,&
1601 eps1,eps2rt**2,eps3rt**2,&
1602 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
1605 ! Calculate gradient components.
1606 e1=e1*eps1*eps2rt**2*eps3rt**2
1607 fac=-expon*(e1+evdwij)*rij_shift
1609 fac=rij*fac-2*expon*rrij*e_augm
1610 ! Calculate the radial part of the gradient
1614 ! Calculate angular part of the gradient.
1620 !-----------------------------------------------------------------------------
1621 !el subroutine sc_angular in module geometry
1622 !-----------------------------------------------------------------------------
1623 subroutine e_softsphere(evdw)
1625 ! This subroutine calculates the interaction energy of nonbonded side chains
1626 ! assuming the LJ potential of interaction.
1628 ! implicit real*8 (a-h,o-z)
1629 ! include 'DIMENSIONS'
1630 real(kind=8),parameter :: accur=1.0d-10
1631 ! include 'COMMON.GEO'
1632 ! include 'COMMON.VAR'
1633 ! include 'COMMON.LOCAL'
1634 ! include 'COMMON.CHAIN'
1635 ! include 'COMMON.DERIV'
1636 ! include 'COMMON.INTERACT'
1637 ! include 'COMMON.TORSION'
1638 ! include 'COMMON.SBRIDGE'
1639 ! include 'COMMON.NAMES'
1640 ! include 'COMMON.IOUNITS'
1641 ! include 'COMMON.CONTACTS'
1642 real(kind=8),dimension(3) :: gg
1643 !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1645 integer :: i,iint,j,itypi,itypi1,itypj,k
1646 real(kind=8) :: evdw,xj,yj,zj,xi,yi,zi,rij,r0ij,r0ijsq,evdwij
1650 do i=iatsc_s,iatsc_e
1651 itypi=iabs(itype(i))
1652 if (itypi.eq.ntyp1) cycle
1653 itypi1=iabs(itype(i+1))
1658 ! Calculate SC interaction energy.
1660 do iint=1,nint_gr(i)
1661 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1662 !d & 'iend=',iend(i,iint)
1663 do j=istart(i,iint),iend(i,iint)
1664 itypj=iabs(itype(j))
1665 if (itypj.eq.ntyp1) cycle
1669 rij=xj*xj+yj*yj+zj*zj
1670 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1671 r0ij=r0(itypi,itypj)
1673 ! print *,i,j,r0ij,dsqrt(rij)
1674 if (rij.lt.r0ijsq) then
1675 evdwij=0.25d0*(rij-r0ijsq)**2
1683 ! Calculate the components of the gradient in DC and X
1689 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1690 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1691 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1692 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1696 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1703 end subroutine e_softsphere
1704 !-----------------------------------------------------------------------------
1705 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1707 ! Soft-sphere potential of p-p interaction
1709 ! implicit real*8 (a-h,o-z)
1710 ! include 'DIMENSIONS'
1711 ! include 'COMMON.CONTROL'
1712 ! include 'COMMON.IOUNITS'
1713 ! include 'COMMON.GEO'
1714 ! include 'COMMON.VAR'
1715 ! include 'COMMON.LOCAL'
1716 ! include 'COMMON.CHAIN'
1717 ! include 'COMMON.DERIV'
1718 ! include 'COMMON.INTERACT'
1719 ! include 'COMMON.CONTACTS'
1720 ! include 'COMMON.TORSION'
1721 ! include 'COMMON.VECTORS'
1722 ! include 'COMMON.FFIELD'
1723 real(kind=8),dimension(3) :: ggg
1724 !d write(iout,*) 'In EELEC_soft_sphere'
1726 integer :: i,j,k,num_conti,iteli,itelj
1727 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
1728 real(kind=8) :: dxi,dyi,dzi,xmedi,ymedi,zmedi,r0ij,r0ijsq
1729 real(kind=8) :: dxj,dyj,dzj,xj,yj,zj,rij,evdw1ij,fac
1737 do i=iatel_s,iatel_e
1738 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1742 xmedi=c(1,i)+0.5d0*dxi
1743 ymedi=c(2,i)+0.5d0*dyi
1744 zmedi=c(3,i)+0.5d0*dzi
1746 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1747 do j=ielstart(i),ielend(i)
1748 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1752 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1753 r0ij=rpp(iteli,itelj)
1758 xj=c(1,j)+0.5D0*dxj-xmedi
1759 yj=c(2,j)+0.5D0*dyj-ymedi
1760 zj=c(3,j)+0.5D0*dzj-zmedi
1761 rij=xj*xj+yj*yj+zj*zj
1762 if (rij.lt.r0ijsq) then
1763 evdw1ij=0.25d0*(rij-r0ijsq)**2
1771 ! Calculate contributions to the Cartesian gradient.
1777 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1778 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1781 ! Loop over residues i+1 thru j-1.
1785 !grad gelc(l,k)=gelc(l,k)+ggg(l)
1790 !grad do i=nnt,nct-1
1792 !grad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1794 !grad do j=i+1,nct-1
1796 !grad gelc(k,i)=gelc(k,i)+gelc(k,j)
1801 end subroutine eelec_soft_sphere
1802 !-----------------------------------------------------------------------------
1803 subroutine vec_and_deriv
1804 ! implicit real*8 (a-h,o-z)
1805 ! include 'DIMENSIONS'
1809 ! include 'COMMON.IOUNITS'
1810 ! include 'COMMON.GEO'
1811 ! include 'COMMON.VAR'
1812 ! include 'COMMON.LOCAL'
1813 ! include 'COMMON.CHAIN'
1814 ! include 'COMMON.VECTORS'
1815 ! include 'COMMON.SETUP'
1816 ! include 'COMMON.TIME1'
1817 real(kind=8),dimension(3,3,2) :: uyder,uzder
1818 real(kind=8),dimension(2) :: vbld_inv_temp
1819 ! Compute the local reference systems. For reference system (i), the
1820 ! X-axis points from CA(i) to CA(i+1), the Y axis is in the
1821 ! CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1824 real(kind=8) :: facy,fac,costh
1827 do i=ivec_start,ivec_end
1831 if (i.eq.nres-1) then
1832 ! Case of the last full residue
1833 ! Compute the Z-axis
1834 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1835 costh=dcos(pi-theta(nres))
1836 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1840 ! Compute the derivatives of uz
1842 uzder(2,1,1)=-dc_norm(3,i-1)
1843 uzder(3,1,1)= dc_norm(2,i-1)
1844 uzder(1,2,1)= dc_norm(3,i-1)
1846 uzder(3,2,1)=-dc_norm(1,i-1)
1847 uzder(1,3,1)=-dc_norm(2,i-1)
1848 uzder(2,3,1)= dc_norm(1,i-1)
1851 uzder(2,1,2)= dc_norm(3,i)
1852 uzder(3,1,2)=-dc_norm(2,i)
1853 uzder(1,2,2)=-dc_norm(3,i)
1855 uzder(3,2,2)= dc_norm(1,i)
1856 uzder(1,3,2)= dc_norm(2,i)
1857 uzder(2,3,2)=-dc_norm(1,i)
1859 ! Compute the Y-axis
1862 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1864 ! Compute the derivatives of uy
1867 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) &
1868 -dc_norm(k,i)*dc_norm(j,i-1)
1869 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1871 uyder(j,j,1)=uyder(j,j,1)-costh
1872 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1877 uygrad(l,k,j,i)=uyder(l,k,j)
1878 uzgrad(l,k,j,i)=uzder(l,k,j)
1882 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1883 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1884 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1885 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1888 ! Compute the Z-axis
1889 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1890 costh=dcos(pi-theta(i+2))
1891 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1895 ! Compute the derivatives of uz
1897 uzder(2,1,1)=-dc_norm(3,i+1)
1898 uzder(3,1,1)= dc_norm(2,i+1)
1899 uzder(1,2,1)= dc_norm(3,i+1)
1901 uzder(3,2,1)=-dc_norm(1,i+1)
1902 uzder(1,3,1)=-dc_norm(2,i+1)
1903 uzder(2,3,1)= dc_norm(1,i+1)
1906 uzder(2,1,2)= dc_norm(3,i)
1907 uzder(3,1,2)=-dc_norm(2,i)
1908 uzder(1,2,2)=-dc_norm(3,i)
1910 uzder(3,2,2)= dc_norm(1,i)
1911 uzder(1,3,2)= dc_norm(2,i)
1912 uzder(2,3,2)=-dc_norm(1,i)
1914 ! Compute the Y-axis
1917 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1919 ! Compute the derivatives of uy
1922 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) &
1923 -dc_norm(k,i)*dc_norm(j,i+1)
1924 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1926 uyder(j,j,1)=uyder(j,j,1)-costh
1927 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1932 uygrad(l,k,j,i)=uyder(l,k,j)
1933 uzgrad(l,k,j,i)=uzder(l,k,j)
1937 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1938 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1939 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1940 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1944 vbld_inv_temp(1)=vbld_inv(i+1)
1945 if (i.lt.nres-1) then
1946 vbld_inv_temp(2)=vbld_inv(i+2)
1948 vbld_inv_temp(2)=vbld_inv(i)
1953 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1954 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1959 #if defined(PARVEC) && defined(MPI)
1960 if (nfgtasks1.gt.1) then
1962 ! print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
1963 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
1964 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
1965 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),&
1966 MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
1968 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),&
1969 MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
1971 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),&
1972 ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),&
1973 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
1974 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),&
1975 ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),&
1976 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
1977 time_gather=time_gather+MPI_Wtime()-time00
1979 ! if (fg_rank.eq.0) then
1980 ! write (iout,*) "Arrays UY and UZ"
1982 ! write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
1988 end subroutine vec_and_deriv
1989 !-----------------------------------------------------------------------------
1990 subroutine check_vecgrad
1991 ! implicit real*8 (a-h,o-z)
1992 ! include 'DIMENSIONS'
1993 ! include 'COMMON.IOUNITS'
1994 ! include 'COMMON.GEO'
1995 ! include 'COMMON.VAR'
1996 ! include 'COMMON.LOCAL'
1997 ! include 'COMMON.CHAIN'
1998 ! include 'COMMON.VECTORS'
1999 real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
2000 real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
2001 real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
2002 real(kind=8),dimension(3) :: erij
2003 real(kind=8) :: delta=1.0d-7
2009 !rc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2010 !rc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2011 !rc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2012 !d write(iout,'(2i5,2(3f10.5,5x))') i,1,
2013 !d & (dc_norm(if90,i),if90=1,3)
2014 !d write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2015 !d write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2016 !d write(iout,'(a)')
2022 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2023 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2036 !d write (iout,*) 'i=',i
2038 erij(k)=dc_norm(k,i)
2042 dc_norm(k,i)=erij(k)
2044 dc_norm(j,i)=dc_norm(j,i)+delta
2045 ! fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2047 ! dc_norm(k,i)=dc_norm(k,i)/fac
2049 ! write (iout,*) (dc_norm(k,i),k=1,3)
2050 ! write (iout,*) (erij(k),k=1,3)
2053 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2054 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2055 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2056 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2058 ! write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2059 ! & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2060 ! & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2063 dc_norm(k,i)=erij(k)
2066 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2067 !d & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2068 !d & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2069 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2070 !d & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2071 !d & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2072 !d write (iout,'(a)')
2076 end subroutine check_vecgrad
2077 !-----------------------------------------------------------------------------
2078 subroutine set_matrices
2079 ! implicit real*8 (a-h,o-z)
2080 ! include 'DIMENSIONS'
2083 ! include "COMMON.SETUP"
2085 integer :: status(MPI_STATUS_SIZE)
2087 ! include 'COMMON.IOUNITS'
2088 ! include 'COMMON.GEO'
2089 ! include 'COMMON.VAR'
2090 ! include 'COMMON.LOCAL'
2091 ! include 'COMMON.CHAIN'
2092 ! include 'COMMON.DERIV'
2093 ! include 'COMMON.INTERACT'
2094 ! include 'COMMON.CONTACTS'
2095 ! include 'COMMON.TORSION'
2096 ! include 'COMMON.VECTORS'
2097 ! include 'COMMON.FFIELD'
2098 real(kind=8) :: auxvec(2),auxmat(2,2)
2099 integer :: i,iti1,iti,k,l
2100 real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2
2103 ! Compute the virtual-bond-torsional-angle dependent quantities needed
2104 ! to calculate the el-loc multibody terms of various order.
2108 do i=ivec_start+2,ivec_end+2
2112 if (i .lt. nres+1) then
2149 if (i .gt. 3 .and. i .lt. nres+1) then
2150 obrot_der(1,i-2)=-sin1
2151 obrot_der(2,i-2)= cos1
2152 Ugder(1,1,i-2)= sin1
2153 Ugder(1,2,i-2)=-cos1
2154 Ugder(2,1,i-2)=-cos1
2155 Ugder(2,2,i-2)=-sin1
2158 obrot2_der(1,i-2)=-dwasin2
2159 obrot2_der(2,i-2)= dwacos2
2160 Ug2der(1,1,i-2)= dwasin2
2161 Ug2der(1,2,i-2)=-dwacos2
2162 Ug2der(2,1,i-2)=-dwacos2
2163 Ug2der(2,2,i-2)=-dwasin2
2165 obrot_der(1,i-2)=0.0d0
2166 obrot_der(2,i-2)=0.0d0
2167 Ugder(1,1,i-2)=0.0d0
2168 Ugder(1,2,i-2)=0.0d0
2169 Ugder(2,1,i-2)=0.0d0
2170 Ugder(2,2,i-2)=0.0d0
2171 obrot2_der(1,i-2)=0.0d0
2172 obrot2_der(2,i-2)=0.0d0
2173 Ug2der(1,1,i-2)=0.0d0
2174 Ug2der(1,2,i-2)=0.0d0
2175 Ug2der(2,1,i-2)=0.0d0
2176 Ug2der(2,2,i-2)=0.0d0
2178 ! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2179 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2180 iti = itortyp(itype(i-2))
2184 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2185 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2186 iti1 = itortyp(itype(i-1))
2190 !d write (iout,*) '*******i',i,' iti1',iti
2191 !d write (iout,*) 'b1',b1(:,iti)
2192 !d write (iout,*) 'b2',b2(:,iti)
2193 !d write (iout,*) 'Ug',Ug(:,:,i-2)
2194 ! if (i .gt. iatel_s+2) then
2195 if (i .gt. nnt+2) then
2196 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2197 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2198 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2200 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2201 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2202 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2203 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2204 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2215 DtUg2(l,k,i-2)=0.0d0
2219 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2220 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2222 muder(k,i-2)=Ub2der(k,i-2)
2224 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2225 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2226 if (itype(i-1).le.ntyp) then
2227 iti1 = itortyp(itype(i-1))
2235 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2237 ! if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
2238 ! if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,iti1)
2239 ! if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
2240 !d write (iout,*) 'mu1',mu1(:,i-2)
2241 !d write (iout,*) 'mu2',mu2(:,i-2)
2242 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2244 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2245 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2246 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2247 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2248 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2249 ! Vectors and matrices dependent on a single virtual-bond dihedral.
2250 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2251 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2252 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2253 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2254 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2255 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2256 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2257 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2258 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2261 ! Matrices dependent on two consecutive virtual-bond dihedrals.
2262 ! The order of matrices is from left to right.
2263 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2265 ! do i=max0(ivec_start,2),ivec_end
2267 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2268 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2269 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2270 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2271 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2272 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2273 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2274 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2277 #if defined(MPI) && defined(PARMAT)
2279 ! if (fg_rank.eq.0) then
2280 write (iout,*) "Arrays UG and UGDER before GATHER"
2282 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2283 ((ug(l,k,i),l=1,2),k=1,2),&
2284 ((ugder(l,k,i),l=1,2),k=1,2)
2286 write (iout,*) "Arrays UG2 and UG2DER"
2288 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2289 ((ug2(l,k,i),l=1,2),k=1,2),&
2290 ((ug2der(l,k,i),l=1,2),k=1,2)
2292 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2294 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2295 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2296 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2298 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2300 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2301 costab(i),sintab(i),costab2(i),sintab2(i)
2303 write (iout,*) "Array MUDER"
2305 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2309 if (nfgtasks.gt.1) then
2311 ! write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2312 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2313 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2315 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),&
2316 MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2318 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),&
2319 MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2321 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),&
2322 MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2324 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),&
2325 MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2327 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),&
2328 MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2330 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),&
2331 MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2333 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),&
2334 MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),&
2335 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2336 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),&
2337 MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),&
2338 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2339 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),&
2340 MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),&
2341 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2342 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),&
2343 MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),&
2344 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2345 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2347 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),&
2348 MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2350 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),&
2351 MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2353 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),&
2354 MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2356 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),&
2357 MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2359 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),&
2360 MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2362 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),&
2363 ivec_count(fg_rank1),&
2364 MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2366 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),&
2367 MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2369 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),&
2370 MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2372 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),&
2373 MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2375 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),&
2376 MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2378 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),&
2379 MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2381 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),&
2382 MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2384 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),&
2385 MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2387 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),&
2388 ivec_count(fg_rank1),&
2389 MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2391 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),&
2392 MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2394 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),&
2395 MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2397 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),&
2398 MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2400 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),&
2401 MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2403 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),&
2404 ivec_count(fg_rank1),&
2405 MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2407 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),&
2408 ivec_count(fg_rank1),&
2409 MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2411 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),&
2412 ivec_count(fg_rank1),&
2413 MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2414 MPI_MAT2,FG_COMM1,IERR)
2415 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),&
2416 ivec_count(fg_rank1),&
2417 MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2418 MPI_MAT2,FG_COMM1,IERR)
2421 ! Passes matrix info through the ring
2424 if (irecv.lt.0) irecv=nfgtasks1-1
2427 if (inext.ge.nfgtasks1) inext=0
2429 ! write (iout,*) "isend",isend," irecv",irecv
2431 lensend=lentyp(isend)
2432 lenrecv=lentyp(irecv)
2433 ! write (iout,*) "lensend",lensend," lenrecv",lenrecv
2434 ! call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2435 ! & MPI_ROTAT1(lensend),inext,2200+isend,
2436 ! & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2437 ! & iprev,2200+irecv,FG_COMM,status,IERR)
2438 ! write (iout,*) "Gather ROTAT1"
2440 ! call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2441 ! & MPI_ROTAT2(lensend),inext,3300+isend,
2442 ! & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2443 ! & iprev,3300+irecv,FG_COMM,status,IERR)
2444 ! write (iout,*) "Gather ROTAT2"
2446 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,&
2447 MPI_ROTAT_OLD(lensend),inext,4400+isend,&
2448 costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),&
2449 iprev,4400+irecv,FG_COMM,status,IERR)
2450 ! write (iout,*) "Gather ROTAT_OLD"
2452 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,&
2453 MPI_PRECOMP11(lensend),inext,5500+isend,&
2454 mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),&
2455 iprev,5500+irecv,FG_COMM,status,IERR)
2456 ! write (iout,*) "Gather PRECOMP11"
2458 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,&
2459 MPI_PRECOMP12(lensend),inext,6600+isend,&
2460 Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),&
2461 iprev,6600+irecv,FG_COMM,status,IERR)
2462 ! write (iout,*) "Gather PRECOMP12"
2464 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2466 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,&
2467 MPI_ROTAT2(lensend),inext,7700+isend,&
2468 ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),&
2469 iprev,7700+irecv,FG_COMM,status,IERR)
2470 ! write (iout,*) "Gather PRECOMP21"
2472 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,&
2473 MPI_PRECOMP22(lensend),inext,8800+isend,&
2474 EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),&
2475 iprev,8800+irecv,FG_COMM,status,IERR)
2476 ! write (iout,*) "Gather PRECOMP22"
2478 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,&
2479 MPI_PRECOMP23(lensend),inext,9900+isend,&
2480 Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,&
2481 MPI_PRECOMP23(lenrecv),&
2482 iprev,9900+irecv,FG_COMM,status,IERR)
2483 ! write (iout,*) "Gather PRECOMP23"
2488 if (irecv.lt.0) irecv=nfgtasks1-1
2491 time_gather=time_gather+MPI_Wtime()-time00
2494 ! if (fg_rank.eq.0) then
2495 write (iout,*) "Arrays UG and UGDER"
2497 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2498 ((ug(l,k,i),l=1,2),k=1,2),&
2499 ((ugder(l,k,i),l=1,2),k=1,2)
2501 write (iout,*) "Arrays UG2 and UG2DER"
2503 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2504 ((ug2(l,k,i),l=1,2),k=1,2),&
2505 ((ug2der(l,k,i),l=1,2),k=1,2)
2507 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2509 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2510 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2511 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2513 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2515 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2516 costab(i),sintab(i),costab2(i),sintab2(i)
2518 write (iout,*) "Array MUDER"
2520 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2526 !d iti = itortyp(itype(i))
2529 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2530 !d & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2534 end subroutine set_matrices
2535 !-----------------------------------------------------------------------------
2536 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2538 ! This subroutine calculates the average interaction energy and its gradient
2539 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
2540 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2541 ! The potential depends both on the distance of peptide-group centers and on
2542 ! the orientation of the CA-CA virtual bonds.
2545 ! implicit real*8 (a-h,o-z)
2549 ! include 'DIMENSIONS'
2550 ! include 'COMMON.CONTROL'
2551 ! include 'COMMON.SETUP'
2552 ! include 'COMMON.IOUNITS'
2553 ! include 'COMMON.GEO'
2554 ! include 'COMMON.VAR'
2555 ! include 'COMMON.LOCAL'
2556 ! include 'COMMON.CHAIN'
2557 ! include 'COMMON.DERIV'
2558 ! include 'COMMON.INTERACT'
2559 ! include 'COMMON.CONTACTS'
2560 ! include 'COMMON.TORSION'
2561 ! include 'COMMON.VECTORS'
2562 ! include 'COMMON.FFIELD'
2563 ! include 'COMMON.TIME1'
2564 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
2565 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2566 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2567 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2568 real(kind=8),dimension(4) :: muij
2569 !el integer :: num_conti,j1,j2
2570 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2571 !el dz_normi,xmedi,ymedi,zmedi
2573 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2574 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
2577 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2579 real(kind=8) :: scal_el=1.0d0
2581 real(kind=8) :: scal_el=0.5d0
2584 ! 13-go grudnia roku pamietnego...
2585 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
2587 0.0d0,0.0d0,1.0d0/),shape(unmat))
2590 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2591 real(kind=8) :: fac,t_eelecij
2594 !d write(iout,*) 'In EELEC'
2596 !d write(iout,*) 'Type',i
2597 !d write(iout,*) 'B1',B1(:,i)
2598 !d write(iout,*) 'B2',B2(:,i)
2599 !d write(iout,*) 'CC',CC(:,:,i)
2600 !d write(iout,*) 'DD',DD(:,:,i)
2601 !d write(iout,*) 'EE',EE(:,:,i)
2603 !d call check_vecgrad
2618 if (icheckgrad.eq.1) then
2621 ! dc_norm(1,i)=0.0d0
2622 ! dc_norm(2,i)=0.0d0
2623 ! dc_norm(3,i)=0.0d0
2626 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2628 dc_norm(k,i)=dc(k,i)*fac
2630 ! write (iout,*) 'i',i,' fac',fac
2633 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
2634 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
2635 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2636 ! call vec_and_deriv
2642 time_mat=time_mat+MPI_Wtime()-time01
2646 !d write (iout,*) 'i=',i
2648 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2651 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2652 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2665 !d print '(a)','Enter EELEC'
2666 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2667 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
2668 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
2670 gel_loc_loc(i)=0.0d0
2675 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2677 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
2682 do i=iturn3_start,iturn3_end
2683 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
2684 .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2688 dx_normi=dc_norm(1,i)
2689 dy_normi=dc_norm(2,i)
2690 dz_normi=dc_norm(3,i)
2691 xmedi=c(1,i)+0.5d0*dxi
2692 ymedi=c(2,i)+0.5d0*dyi
2693 zmedi=c(3,i)+0.5d0*dzi
2695 call eelecij(i,i+2,ees,evdw1,eel_loc)
2696 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2697 num_cont_hb(i)=num_conti
2699 do i=iturn4_start,iturn4_end
2700 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
2701 .or. itype(i+3).eq.ntyp1 &
2702 .or. itype(i+4).eq.ntyp1) cycle
2706 dx_normi=dc_norm(1,i)
2707 dy_normi=dc_norm(2,i)
2708 dz_normi=dc_norm(3,i)
2709 xmedi=c(1,i)+0.5d0*dxi
2710 ymedi=c(2,i)+0.5d0*dyi
2711 zmedi=c(3,i)+0.5d0*dzi
2712 num_conti=num_cont_hb(i)
2713 call eelecij(i,i+3,ees,evdw1,eel_loc)
2714 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
2715 call eturn4(i,eello_turn4)
2716 num_cont_hb(i)=num_conti
2719 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2721 do i=iatel_s,iatel_e
2722 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2726 dx_normi=dc_norm(1,i)
2727 dy_normi=dc_norm(2,i)
2728 dz_normi=dc_norm(3,i)
2729 xmedi=c(1,i)+0.5d0*dxi
2730 ymedi=c(2,i)+0.5d0*dyi
2731 zmedi=c(3,i)+0.5d0*dzi
2732 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2733 num_conti=num_cont_hb(i)
2734 do j=ielstart(i),ielend(i)
2735 ! write (iout,*) i,j,itype(i),itype(j)
2736 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2737 call eelecij(i,j,ees,evdw1,eel_loc)
2739 num_cont_hb(i)=num_conti
2741 ! write (iout,*) "Number of loop steps in EELEC:",ind
2743 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
2744 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2746 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2747 !cc eel_loc=eel_loc+eello_turn3
2748 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
2750 end subroutine eelec
2751 !-----------------------------------------------------------------------------
2752 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2755 ! implicit real*8 (a-h,o-z)
2756 ! include 'DIMENSIONS'
2760 ! include 'COMMON.CONTROL'
2761 ! include 'COMMON.IOUNITS'
2762 ! include 'COMMON.GEO'
2763 ! include 'COMMON.VAR'
2764 ! include 'COMMON.LOCAL'
2765 ! include 'COMMON.CHAIN'
2766 ! include 'COMMON.DERIV'
2767 ! include 'COMMON.INTERACT'
2768 ! include 'COMMON.CONTACTS'
2769 ! include 'COMMON.TORSION'
2770 ! include 'COMMON.VECTORS'
2771 ! include 'COMMON.FFIELD'
2772 ! include 'COMMON.TIME1'
2773 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
2774 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2775 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2776 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2777 real(kind=8),dimension(4) :: muij
2778 !el integer :: num_conti,j1,j2
2779 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2780 !el dz_normi,xmedi,ymedi,zmedi
2782 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2783 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
2786 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2788 real(kind=8) :: scal_el=1.0d0
2790 real(kind=8) :: scal_el=0.5d0
2793 ! 13-go grudnia roku pamietnego...
2794 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
2796 0.0d0,0.0d0,1.0d0/),shape(unmat))
2797 ! integer :: maxconts=nres/4
2799 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m
2800 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
2801 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
2802 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
2803 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
2804 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
2805 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
2806 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
2807 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
2808 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
2809 ecosgp,ecosam,ecosbm,ecosgm,ghalf
2811 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
2812 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
2814 ! time00=MPI_Wtime()
2815 !d write (iout,*) "eelecij",i,j
2819 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2820 aaa=app(iteli,itelj)
2821 bbb=bpp(iteli,itelj)
2822 ael6i=ael6(iteli,itelj)
2823 ael3i=ael3(iteli,itelj)
2827 dx_normj=dc_norm(1,j)
2828 dy_normj=dc_norm(2,j)
2829 dz_normj=dc_norm(3,j)
2830 xj=c(1,j)+0.5D0*dxj-xmedi
2831 yj=c(2,j)+0.5D0*dyj-ymedi
2832 zj=c(3,j)+0.5D0*dzj-zmedi
2833 rij=xj*xj+yj*yj+zj*zj
2839 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2840 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2841 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2842 fac=cosa-3.0D0*cosb*cosg
2844 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2845 if (j.eq.i+2) ev1=scal_el*ev1
2850 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2853 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
2854 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2857 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2858 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2859 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2860 !d & xmedi,ymedi,zmedi,xj,yj,zj
2862 if (energy_dec) then
2863 ! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
2864 ! 'evdw1',i,j,evdwij,&
2865 ! iteli,itelj,aaa,evdw1
2866 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
2867 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2870 ! Calculate contributions to the Cartesian gradient.
2873 facvdw=-6*rrmij*(ev1+evdwij)
2874 facel=-3*rrmij*(el1+eesij)
2880 ! Radial derivatives. First process both termini of the fragment (i,j)
2886 ! ghalf=0.5D0*ggg(k)
2887 ! gelc(k,i)=gelc(k,i)+ghalf
2888 ! gelc(k,j)=gelc(k,j)+ghalf
2890 ! 9/28/08 AL Gradient compotents will be summed only at the end
2892 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2893 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2896 ! Loop over residues i+1 thru j-1.
2900 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2907 ! ghalf=0.5D0*ggg(k)
2908 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2909 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2911 ! 9/28/08 AL Gradient compotents will be summed only at the end
2913 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2914 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2917 ! Loop over residues i+1 thru j-1.
2921 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2928 fac=-3*rrmij*(facvdw+facvdw+facel)
2933 ! Radial derivatives. First process both termini of the fragment (i,j)
2939 ! ghalf=0.5D0*ggg(k)
2940 ! gelc(k,i)=gelc(k,i)+ghalf
2941 ! gelc(k,j)=gelc(k,j)+ghalf
2943 ! 9/28/08 AL Gradient compotents will be summed only at the end
2945 gelc_long(k,j)=gelc(k,j)+ggg(k)
2946 gelc_long(k,i)=gelc(k,i)-ggg(k)
2949 ! Loop over residues i+1 thru j-1.
2953 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2956 ! 9/28/08 AL Gradient compotents will be summed only at the end
2961 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2962 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2968 ecosa=2.0D0*fac3*fac1+fac4
2971 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2972 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2974 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2975 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2977 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2978 !d & (dcosg(k),k=1,3)
2980 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2983 ! ghalf=0.5D0*ggg(k)
2984 ! gelc(k,i)=gelc(k,i)+ghalf
2985 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2986 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2987 ! gelc(k,j)=gelc(k,j)+ghalf
2988 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2989 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2993 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2997 gelc(k,i)=gelc(k,i) &
2998 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
2999 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3000 gelc(k,j)=gelc(k,j) &
3001 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3002 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3003 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3004 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3006 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3007 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
3008 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3010 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3011 ! energy of a peptide unit is assumed in the form of a second-order
3012 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3013 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3014 ! are computed for EVERY pair of non-contiguous peptide groups.
3016 if (j.lt.nres-1) then
3027 muij(kkk)=mu(k,i)*mu(l,j)
3030 !d write (iout,*) 'EELEC: i',i,' j',j
3031 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
3032 !d write(iout,*) 'muij',muij
3033 ury=scalar(uy(1,i),erij)
3034 urz=scalar(uz(1,i),erij)
3035 vry=scalar(uy(1,j),erij)
3036 vrz=scalar(uz(1,j),erij)
3037 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3038 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3039 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3040 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3041 fac=dsqrt(-ael6i)*r3ij
3046 !d write (iout,'(4i5,4f10.5)')
3047 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3048 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3049 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3050 !d & uy(:,j),uz(:,j)
3051 !d write (iout,'(4f10.5)')
3052 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3053 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3054 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
3055 !d write (iout,'(9f10.5/)')
3056 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3057 ! Derivatives of the elements of A in virtual-bond vectors
3058 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3060 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3061 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3062 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3063 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3064 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3065 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3066 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3067 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3068 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3069 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3070 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3071 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3073 ! Compute radial contributions to the gradient
3091 ! Add the contributions coming from er
3094 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3095 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3096 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3097 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3100 ! Derivatives in DC(i)
3101 !grad ghalf1=0.5d0*agg(k,1)
3102 !grad ghalf2=0.5d0*agg(k,2)
3103 !grad ghalf3=0.5d0*agg(k,3)
3104 !grad ghalf4=0.5d0*agg(k,4)
3105 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
3106 -3.0d0*uryg(k,2)*vry)!+ghalf1
3107 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
3108 -3.0d0*uryg(k,2)*vrz)!+ghalf2
3109 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
3110 -3.0d0*urzg(k,2)*vry)!+ghalf3
3111 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
3112 -3.0d0*urzg(k,2)*vrz)!+ghalf4
3113 ! Derivatives in DC(i+1)
3114 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
3115 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3116 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
3117 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3118 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
3119 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3120 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
3121 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3122 ! Derivatives in DC(j)
3123 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
3124 -3.0d0*vryg(k,2)*ury)!+ghalf1
3125 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
3126 -3.0d0*vrzg(k,2)*ury)!+ghalf2
3127 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
3128 -3.0d0*vryg(k,2)*urz)!+ghalf3
3129 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
3130 -3.0d0*vrzg(k,2)*urz)!+ghalf4
3131 ! Derivatives in DC(j+1) or DC(nres-1)
3132 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
3133 -3.0d0*vryg(k,3)*ury)
3134 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
3135 -3.0d0*vrzg(k,3)*ury)
3136 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
3137 -3.0d0*vryg(k,3)*urz)
3138 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
3139 -3.0d0*vrzg(k,3)*urz)
3140 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
3142 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3155 aggi(k,l)=-aggi(k,l)
3156 aggi1(k,l)=-aggi1(k,l)
3157 aggj(k,l)=-aggj(k,l)
3158 aggj1(k,l)=-aggj1(k,l)
3161 if (j.lt.nres-1) then
3167 aggi(k,l)=-aggi(k,l)
3168 aggi1(k,l)=-aggi1(k,l)
3169 aggj(k,l)=-aggj(k,l)
3170 aggj1(k,l)=-aggj1(k,l)
3181 aggi(k,l)=-aggi(k,l)
3182 aggi1(k,l)=-aggi1(k,l)
3183 aggj(k,l)=-aggj(k,l)
3184 aggj1(k,l)=-aggj1(k,l)
3189 IF (wel_loc.gt.0.0d0) THEN
3190 ! Contribution to the local-electrostatic energy coming from the i-j pair
3191 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
3193 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3195 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3196 'eelloc',i,j,eel_loc_ij
3197 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
3198 ! if (energy_dec) write (iout,*) "muij",muij
3199 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3201 eel_loc=eel_loc+eel_loc_ij
3202 ! Partial derivatives in virtual-bond dihedral angles gamma
3204 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
3205 a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
3206 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3207 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
3208 a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
3209 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3210 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3212 ggg(l)=agg(l,1)*muij(1)+ &
3213 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3214 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3215 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3216 !grad ghalf=0.5d0*ggg(l)
3217 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
3218 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
3222 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3225 ! Remaining derivatives of eello
3227 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ &
3228 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3229 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ &
3230 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3231 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ &
3232 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3233 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ &
3234 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3237 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
3238 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
3239 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
3240 .and. num_conti.le.maxconts) then
3241 ! write (iout,*) i,j," entered corr"
3243 ! Calculate the contact function. The ith column of the array JCONT will
3244 ! contain the numbers of atoms that make contacts with the atom I (of numbers
3245 ! greater than I). The arrays FACONT and GACONT will contain the values of
3246 ! the contact function and its derivative.
3247 ! r0ij=1.02D0*rpp(iteli,itelj)
3248 ! r0ij=1.11D0*rpp(iteli,itelj)
3249 r0ij=2.20D0*rpp(iteli,itelj)
3250 ! r0ij=1.55D0*rpp(iteli,itelj)
3251 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3252 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
3253 if (fcont.gt.0.0D0) then
3254 num_conti=num_conti+1
3255 if (num_conti.gt.maxconts) then
3256 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
3257 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
3258 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
3259 ' will skip next contacts for this conf.', num_conti
3261 jcont_hb(num_conti,i)=j
3262 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
3263 !d & " jcont_hb",jcont_hb(num_conti,i)
3264 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
3265 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3266 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3268 d_cont(num_conti,i)=rij
3269 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3270 ! --- Electrostatic-interaction matrix ---
3271 a_chuj(1,1,num_conti,i)=a22
3272 a_chuj(1,2,num_conti,i)=a23
3273 a_chuj(2,1,num_conti,i)=a32
3274 a_chuj(2,2,num_conti,i)=a33
3275 ! --- Gradient of rij
3277 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3284 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3285 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3286 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3287 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3288 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3293 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3294 ! Calculate contact energies
3296 wij=cosa-3.0D0*cosb*cosg
3299 ! fac3=dsqrt(-ael6i)/r0ij**3
3300 fac3=dsqrt(-ael6i)*r3ij
3301 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3302 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3303 if (ees0tmp.gt.0) then
3304 ees0pij=dsqrt(ees0tmp)
3308 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3309 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3310 if (ees0tmp.gt.0) then
3311 ees0mij=dsqrt(ees0tmp)
3316 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3317 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3318 ! Diagnostics. Comment out or remove after debugging!
3319 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3320 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3321 ! ees0m(num_conti,i)=0.0D0
3323 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3324 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3325 ! Angular derivatives of the contact function
3326 ees0pij1=fac3/ees0pij
3327 ees0mij1=fac3/ees0mij
3328 fac3p=-3.0D0*fac3*rrmij
3329 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3330 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3332 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3333 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3334 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3335 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3336 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3337 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3338 ecosap=ecosa1+ecosa2
3339 ecosbp=ecosb1+ecosb2
3340 ecosgp=ecosg1+ecosg2
3341 ecosam=ecosa1-ecosa2
3342 ecosbm=ecosb1-ecosb2
3343 ecosgm=ecosg1-ecosg2
3352 facont_hb(num_conti,i)=fcont
3353 fprimcont=fprimcont/rij
3354 !d facont_hb(num_conti,i)=1.0D0
3355 ! Following line is for diagnostics.
3358 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3359 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3362 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3363 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3365 gggp(1)=gggp(1)+ees0pijp*xj
3366 gggp(2)=gggp(2)+ees0pijp*yj
3367 gggp(3)=gggp(3)+ees0pijp*zj
3368 gggm(1)=gggm(1)+ees0mijp*xj
3369 gggm(2)=gggm(2)+ees0mijp*yj
3370 gggm(3)=gggm(3)+ees0mijp*zj
3371 ! Derivatives due to the contact function
3372 gacont_hbr(1,num_conti,i)=fprimcont*xj
3373 gacont_hbr(2,num_conti,i)=fprimcont*yj
3374 gacont_hbr(3,num_conti,i)=fprimcont*zj
3377 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
3378 ! following the change of gradient-summation algorithm.
3380 !grad ghalfp=0.5D0*gggp(k)
3381 !grad ghalfm=0.5D0*gggm(k)
3382 gacontp_hb1(k,num_conti,i)= & !ghalfp+
3383 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3384 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3385 gacontp_hb2(k,num_conti,i)= & !ghalfp+
3386 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3387 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3388 gacontp_hb3(k,num_conti,i)=gggp(k)
3389 gacontm_hb1(k,num_conti,i)= & !ghalfm+
3390 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3391 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3392 gacontm_hb2(k,num_conti,i)= & !ghalfm+
3393 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3394 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3395 gacontm_hb3(k,num_conti,i)=gggm(k)
3397 ! Diagnostics. Comment out or remove after debugging!
3399 !diag gacontp_hb1(k,num_conti,i)=0.0D0
3400 !diag gacontp_hb2(k,num_conti,i)=0.0D0
3401 !diag gacontp_hb3(k,num_conti,i)=0.0D0
3402 !diag gacontm_hb1(k,num_conti,i)=0.0D0
3403 !diag gacontm_hb2(k,num_conti,i)=0.0D0
3404 !diag gacontm_hb3(k,num_conti,i)=0.0D0
3407 endif ! num_conti.le.maxconts
3410 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3413 ghalf=0.5d0*agg(l,k)
3414 aggi(l,k)=aggi(l,k)+ghalf
3415 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3416 aggj(l,k)=aggj(l,k)+ghalf
3419 if (j.eq.nres-1 .and. i.lt.j-2) then
3422 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3427 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
3429 end subroutine eelecij
3430 !-----------------------------------------------------------------------------
3431 subroutine eturn3(i,eello_turn3)
3432 ! Third- and fourth-order contributions from turns
3435 ! implicit real*8 (a-h,o-z)
3436 ! include 'DIMENSIONS'
3437 ! include 'COMMON.IOUNITS'
3438 ! include 'COMMON.GEO'
3439 ! include 'COMMON.VAR'
3440 ! include 'COMMON.LOCAL'
3441 ! include 'COMMON.CHAIN'
3442 ! include 'COMMON.DERIV'
3443 ! include 'COMMON.INTERACT'
3444 ! include 'COMMON.CONTACTS'
3445 ! include 'COMMON.TORSION'
3446 ! include 'COMMON.VECTORS'
3447 ! include 'COMMON.FFIELD'
3448 ! include 'COMMON.CONTROL'
3449 real(kind=8),dimension(3) :: ggg
3450 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
3451 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
3452 real(kind=8),dimension(2) :: auxvec,auxvec1
3453 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3454 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
3455 !el integer :: num_conti,j1,j2
3456 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3457 !el dz_normi,xmedi,ymedi,zmedi
3459 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3460 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3464 real(kind=8) :: eello_turn3
3467 ! write (iout,*) "eturn3",i,j,j1,j2
3472 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3474 ! Third-order contributions
3481 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3482 !d call checkint_turn3(i,a_temp,eello_turn3_num)
3483 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3484 call transpose2(auxmat(1,1),auxmat1(1,1))
3485 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3486 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3487 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3488 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3489 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
3490 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
3491 !d & ' eello_turn3_num',4*eello_turn3_num
3492 ! Derivatives in gamma(i)
3493 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3494 call transpose2(auxmat2(1,1),auxmat3(1,1))
3495 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3496 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3497 ! Derivatives in gamma(i+1)
3498 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3499 call transpose2(auxmat2(1,1),auxmat3(1,1))
3500 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3501 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
3502 +0.5d0*(pizda(1,1)+pizda(2,2))
3503 ! Cartesian derivatives
3505 ! ghalf1=0.5d0*agg(l,1)
3506 ! ghalf2=0.5d0*agg(l,2)
3507 ! ghalf3=0.5d0*agg(l,3)
3508 ! ghalf4=0.5d0*agg(l,4)
3509 a_temp(1,1)=aggi(l,1)!+ghalf1
3510 a_temp(1,2)=aggi(l,2)!+ghalf2
3511 a_temp(2,1)=aggi(l,3)!+ghalf3
3512 a_temp(2,2)=aggi(l,4)!+ghalf4
3513 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3514 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
3515 +0.5d0*(pizda(1,1)+pizda(2,2))
3516 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3517 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3518 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3519 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3520 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3521 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
3522 +0.5d0*(pizda(1,1)+pizda(2,2))
3523 a_temp(1,1)=aggj(l,1)!+ghalf1
3524 a_temp(1,2)=aggj(l,2)!+ghalf2
3525 a_temp(2,1)=aggj(l,3)!+ghalf3
3526 a_temp(2,2)=aggj(l,4)!+ghalf4
3527 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3528 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
3529 +0.5d0*(pizda(1,1)+pizda(2,2))
3530 a_temp(1,1)=aggj1(l,1)
3531 a_temp(1,2)=aggj1(l,2)
3532 a_temp(2,1)=aggj1(l,3)
3533 a_temp(2,2)=aggj1(l,4)
3534 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3535 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
3536 +0.5d0*(pizda(1,1)+pizda(2,2))
3539 end subroutine eturn3
3540 !-----------------------------------------------------------------------------
3541 subroutine eturn4(i,eello_turn4)
3542 ! Third- and fourth-order contributions from turns
3545 ! implicit real*8 (a-h,o-z)
3546 ! include 'DIMENSIONS'
3547 ! include 'COMMON.IOUNITS'
3548 ! include 'COMMON.GEO'
3549 ! include 'COMMON.VAR'
3550 ! include 'COMMON.LOCAL'
3551 ! include 'COMMON.CHAIN'
3552 ! include 'COMMON.DERIV'
3553 ! include 'COMMON.INTERACT'
3554 ! include 'COMMON.CONTACTS'
3555 ! include 'COMMON.TORSION'
3556 ! include 'COMMON.VECTORS'
3557 ! include 'COMMON.FFIELD'
3558 ! include 'COMMON.CONTROL'
3559 real(kind=8),dimension(3) :: ggg
3560 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
3561 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
3562 real(kind=8),dimension(2) :: auxvec,auxvec1
3563 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3564 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
3565 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3566 !el dz_normi,xmedi,ymedi,zmedi
3567 !el integer :: num_conti,j1,j2
3568 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3569 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3572 integer :: i,j,iti1,iti2,iti3,l
3573 real(kind=8) :: eello_turn4,s1,s2,s3
3576 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3578 ! Fourth-order contributions
3586 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3587 !d call checkint_turn4(i,a_temp,eello_turn4_num)
3588 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3593 iti1=itortyp(itype(i+1))
3594 iti2=itortyp(itype(i+2))
3595 iti3=itortyp(itype(i+3))
3596 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3597 call transpose2(EUg(1,1,i+1),e1t(1,1))
3598 call transpose2(Eug(1,1,i+2),e2t(1,1))
3599 call transpose2(Eug(1,1,i+3),e3t(1,1))
3600 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3601 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3602 s1=scalar2(b1(1,iti2),auxvec(1))
3603 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3604 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3605 s2=scalar2(b1(1,iti1),auxvec(1))
3606 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3607 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3608 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3609 eello_turn4=eello_turn4-(s1+s2+s3)
3610 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3611 'eturn4',i,j,-(s1+s2+s3)
3612 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3613 !d & ' eello_turn4_num',8*eello_turn4_num
3614 ! Derivatives in gamma(i)
3615 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3616 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3617 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3618 s1=scalar2(b1(1,iti2),auxvec(1))
3619 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3620 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3621 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3622 ! Derivatives in gamma(i+1)
3623 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3624 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3625 s2=scalar2(b1(1,iti1),auxvec(1))
3626 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3627 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3628 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3629 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3630 ! Derivatives in gamma(i+2)
3631 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3632 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3633 s1=scalar2(b1(1,iti2),auxvec(1))
3634 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3635 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3636 s2=scalar2(b1(1,iti1),auxvec(1))
3637 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3638 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3639 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3640 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3641 ! Cartesian derivatives
3642 ! Derivatives of this turn contributions in DC(i+2)
3643 if (j.lt.nres-1) then
3645 a_temp(1,1)=agg(l,1)
3646 a_temp(1,2)=agg(l,2)
3647 a_temp(2,1)=agg(l,3)
3648 a_temp(2,2)=agg(l,4)
3649 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3650 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3651 s1=scalar2(b1(1,iti2),auxvec(1))
3652 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3653 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3654 s2=scalar2(b1(1,iti1),auxvec(1))
3655 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3656 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3657 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3659 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3662 ! Remaining derivatives of this turn contribution
3664 a_temp(1,1)=aggi(l,1)
3665 a_temp(1,2)=aggi(l,2)
3666 a_temp(2,1)=aggi(l,3)
3667 a_temp(2,2)=aggi(l,4)
3668 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3669 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3670 s1=scalar2(b1(1,iti2),auxvec(1))
3671 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3672 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3673 s2=scalar2(b1(1,iti1),auxvec(1))
3674 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3675 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3676 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3677 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3678 a_temp(1,1)=aggi1(l,1)
3679 a_temp(1,2)=aggi1(l,2)
3680 a_temp(2,1)=aggi1(l,3)
3681 a_temp(2,2)=aggi1(l,4)
3682 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3683 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3684 s1=scalar2(b1(1,iti2),auxvec(1))
3685 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3686 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3687 s2=scalar2(b1(1,iti1),auxvec(1))
3688 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3689 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3690 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3691 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3692 a_temp(1,1)=aggj(l,1)
3693 a_temp(1,2)=aggj(l,2)
3694 a_temp(2,1)=aggj(l,3)
3695 a_temp(2,2)=aggj(l,4)
3696 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3697 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3698 s1=scalar2(b1(1,iti2),auxvec(1))
3699 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3700 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3701 s2=scalar2(b1(1,iti1),auxvec(1))
3702 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3703 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3704 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3705 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3706 a_temp(1,1)=aggj1(l,1)
3707 a_temp(1,2)=aggj1(l,2)
3708 a_temp(2,1)=aggj1(l,3)
3709 a_temp(2,2)=aggj1(l,4)
3710 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3711 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3712 s1=scalar2(b1(1,iti2),auxvec(1))
3713 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3714 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3715 s2=scalar2(b1(1,iti1),auxvec(1))
3716 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3717 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3718 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3719 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3720 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3723 end subroutine eturn4
3724 !-----------------------------------------------------------------------------
3725 subroutine unormderiv(u,ugrad,unorm,ungrad)
3726 ! This subroutine computes the derivatives of a normalized vector u, given
3727 ! the derivatives computed without normalization conditions, ugrad. Returns
3730 real(kind=8),dimension(3) :: u,vec
3731 real(kind=8),dimension(3,3) ::ugrad,ungrad
3732 real(kind=8) :: unorm !,scalar
3734 ! write (2,*) 'ugrad',ugrad
3737 vec(i)=scalar(ugrad(1,i),u(1))
3739 ! write (2,*) 'vec',vec
3742 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3745 ! write (2,*) 'ungrad',ungrad
3747 end subroutine unormderiv
3748 !-----------------------------------------------------------------------------
3749 subroutine escp_soft_sphere(evdw2,evdw2_14)
3751 ! This subroutine calculates the excluded-volume interaction energy between
3752 ! peptide-group centers and side chains and its gradient in virtual-bond and
3753 ! side-chain vectors.
3755 ! implicit real*8 (a-h,o-z)
3756 ! include 'DIMENSIONS'
3757 ! include 'COMMON.GEO'
3758 ! include 'COMMON.VAR'
3759 ! include 'COMMON.LOCAL'
3760 ! include 'COMMON.CHAIN'
3761 ! include 'COMMON.DERIV'
3762 ! include 'COMMON.INTERACT'
3763 ! include 'COMMON.FFIELD'
3764 ! include 'COMMON.IOUNITS'
3765 ! include 'COMMON.CONTROL'
3766 real(kind=8),dimension(3) :: ggg
3768 integer :: i,iint,j,k,iteli,itypj
3769 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
3770 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
3775 !d print '(a)','Enter ESCP'
3776 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3777 do i=iatscp_s,iatscp_e
3778 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3780 xi=0.5D0*(c(1,i)+c(1,i+1))
3781 yi=0.5D0*(c(2,i)+c(2,i+1))
3782 zi=0.5D0*(c(3,i)+c(3,i+1))
3784 do iint=1,nscp_gr(i)
3786 do j=iscpstart(i,iint),iscpend(i,iint)
3787 if (itype(j).eq.ntyp1) cycle
3788 itypj=iabs(itype(j))
3789 ! Uncomment following three lines for SC-p interactions
3793 ! Uncomment following three lines for Ca-p interactions
3797 rij=xj*xj+yj*yj+zj*zj
3800 if (rij.lt.r0ijsq) then
3801 evdwij=0.25d0*(rij-r0ijsq)**2
3809 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
3814 !grad if (j.lt.i) then
3815 !d write (iout,*) 'j<i'
3816 ! Uncomment following three lines for SC-p interactions
3818 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3821 !d write (iout,*) 'j>i'
3823 !grad ggg(k)=-ggg(k)
3824 ! Uncomment following line for SC-p interactions
3825 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3829 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3831 !grad kstart=min0(i+1,j)
3832 !grad kend=max0(i-1,j-1)
3833 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3834 !d write (iout,*) ggg(1),ggg(2),ggg(3)
3835 !grad do k=kstart,kend
3837 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3841 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3842 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3849 end subroutine escp_soft_sphere
3850 !-----------------------------------------------------------------------------
3851 subroutine escp(evdw2,evdw2_14)
3853 ! This subroutine calculates the excluded-volume interaction energy between
3854 ! peptide-group centers and side chains and its gradient in virtual-bond and
3855 ! side-chain vectors.
3857 ! implicit real*8 (a-h,o-z)
3858 ! include 'DIMENSIONS'
3859 ! include 'COMMON.GEO'
3860 ! include 'COMMON.VAR'
3861 ! include 'COMMON.LOCAL'
3862 ! include 'COMMON.CHAIN'
3863 ! include 'COMMON.DERIV'
3864 ! include 'COMMON.INTERACT'
3865 ! include 'COMMON.FFIELD'
3866 ! include 'COMMON.IOUNITS'
3867 ! include 'COMMON.CONTROL'
3868 real(kind=8),dimension(3) :: ggg
3870 integer :: i,iint,j,k,iteli,itypj
3871 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
3876 !d print '(a)','Enter ESCP'
3877 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3878 do i=iatscp_s,iatscp_e
3879 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3881 xi=0.5D0*(c(1,i)+c(1,i+1))
3882 yi=0.5D0*(c(2,i)+c(2,i+1))
3883 zi=0.5D0*(c(3,i)+c(3,i+1))
3885 do iint=1,nscp_gr(i)
3887 do j=iscpstart(i,iint),iscpend(i,iint)
3888 itypj=iabs(itype(j))
3889 if (itypj.eq.ntyp1) cycle
3890 ! Uncomment following three lines for SC-p interactions
3894 ! Uncomment following three lines for Ca-p interactions
3898 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3900 e1=fac*fac*aad(itypj,iteli)
3901 e2=fac*bad(itypj,iteli)
3902 if (iabs(j-i) .le. 2) then
3905 evdw2_14=evdw2_14+e1+e2
3909 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
3910 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
3911 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3914 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
3916 fac=-(evdwij+e1)*rrij
3920 !grad if (j.lt.i) then
3921 !d write (iout,*) 'j<i'
3922 ! Uncomment following three lines for SC-p interactions
3924 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3927 !d write (iout,*) 'j>i'
3929 !grad ggg(k)=-ggg(k)
3930 ! Uncomment following line for SC-p interactions
3931 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3932 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3936 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3938 !grad kstart=min0(i+1,j)
3939 !grad kend=max0(i-1,j-1)
3940 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3941 !d write (iout,*) ggg(1),ggg(2),ggg(3)
3942 !grad do k=kstart,kend
3944 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3948 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3949 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3957 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3958 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
3959 gradx_scp(j,i)=expon*gradx_scp(j,i)
3962 !******************************************************************************
3966 ! To save time the factor EXPON has been extracted from ALL components
3967 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
3970 !******************************************************************************
3973 !-----------------------------------------------------------------------------
3974 subroutine edis(ehpb)
3976 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3978 ! implicit real*8 (a-h,o-z)
3979 ! include 'DIMENSIONS'
3980 ! include 'COMMON.SBRIDGE'
3981 ! include 'COMMON.CHAIN'
3982 ! include 'COMMON.DERIV'
3983 ! include 'COMMON.VAR'
3984 ! include 'COMMON.INTERACT'
3985 ! include 'COMMON.IOUNITS'
3986 real(kind=8),dimension(3) :: ggg
3988 integer :: i,j,ii,jj,iii,jjj,k
3989 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
3992 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
3993 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
3994 if (link_end.eq.0) return
3995 do i=link_start,link_end
3996 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3997 ! CA-CA distance used in regularization of structure.
4000 ! iii and jjj point to the residues for which the distance is assigned.
4001 if (ii.gt.nres) then
4008 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4009 ! & dhpb(i),dhpb1(i),forcon(i)
4010 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
4011 ! distance and angle dependent SS bond potential.
4012 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4013 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4014 if (.not.dyn_ss .and. i.le.nss) then
4015 ! 15/02/13 CC dynamic SSbond - additional check
4016 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. &
4017 iabs(itype(jjj)).eq.1) then
4018 call ssbond_ene(iii,jjj,eij)
4020 !d write (iout,*) "eij",eij
4023 ! Calculate the distance between the two points and its difference from the
4027 ! Get the force constant corresponding to this distance.
4029 ! Calculate the contribution to energy.
4030 ehpb=ehpb+waga*rdis*rdis
4032 ! Evaluate gradient.
4035 !d print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4036 !d & ' waga=',waga,' fac=',fac
4038 ggg(j)=fac*(c(j,jj)-c(j,ii))
4040 !d print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4041 ! If this is a SC-SC distance, we need to calculate the contributions to the
4042 ! Cartesian gradient in the SC vectors (ghpbx).
4045 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4046 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4049 !grad do j=iii,jjj-1
4051 !grad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4055 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4056 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4063 !-----------------------------------------------------------------------------
4064 subroutine ssbond_ene(i,j,eij)
4066 ! Calculate the distance and angle dependent SS-bond potential energy
4067 ! using a free-energy function derived based on RHF/6-31G** ab initio
4068 ! calculations of diethyl disulfide.
4070 ! A. Liwo and U. Kozlowska, 11/24/03
4072 ! implicit real*8 (a-h,o-z)
4073 ! include 'DIMENSIONS'
4074 ! include 'COMMON.SBRIDGE'
4075 ! include 'COMMON.CHAIN'
4076 ! include 'COMMON.DERIV'
4077 ! include 'COMMON.LOCAL'
4078 ! include 'COMMON.INTERACT'
4079 ! include 'COMMON.VAR'
4080 ! include 'COMMON.IOUNITS'
4081 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
4083 integer :: i,j,itypi,itypj,k
4084 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
4085 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
4086 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
4089 itypi=iabs(itype(i))
4093 dxi=dc_norm(1,nres+i)
4094 dyi=dc_norm(2,nres+i)
4095 dzi=dc_norm(3,nres+i)
4096 ! dsci_inv=dsc_inv(itypi)
4097 dsci_inv=vbld_inv(nres+i)
4098 itypj=iabs(itype(j))
4099 ! dscj_inv=dsc_inv(itypj)
4100 dscj_inv=vbld_inv(nres+j)
4104 dxj=dc_norm(1,nres+j)
4105 dyj=dc_norm(2,nres+j)
4106 dzj=dc_norm(3,nres+j)
4107 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4112 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4113 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4114 om12=dxi*dxj+dyi*dyj+dzi*dzj
4116 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4117 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4123 deltat12=om2-om1+2.0d0
4125 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
4126 +akct*deltad*deltat12 &
4127 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4128 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4129 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4130 ! & " deltat12",deltat12," eij",eij
4131 ed=2*akcm*deltad+akct*deltat12
4133 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4134 eom1=-2*akth*deltat1-pom1-om2*pom2
4135 eom2= 2*akth*deltat2+pom1-om1*pom2
4138 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4139 ghpbx(k,i)=ghpbx(k,i)-ggk &
4140 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
4141 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4142 ghpbx(k,j)=ghpbx(k,j)+ggk &
4143 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
4144 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4145 ghpbc(k,i)=ghpbc(k,i)-ggk
4146 ghpbc(k,j)=ghpbc(k,j)+ggk
4149 ! Calculate the components of the gradient in DC and X
4153 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4157 end subroutine ssbond_ene
4158 !-----------------------------------------------------------------------------
4159 subroutine ebond(estr)
4161 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4163 ! implicit real*8 (a-h,o-z)
4164 ! include 'DIMENSIONS'
4165 ! include 'COMMON.LOCAL'
4166 ! include 'COMMON.GEO'
4167 ! include 'COMMON.INTERACT'
4168 ! include 'COMMON.DERIV'
4169 ! include 'COMMON.VAR'
4170 ! include 'COMMON.CHAIN'
4171 ! include 'COMMON.IOUNITS'
4172 ! include 'COMMON.NAMES'
4173 ! include 'COMMON.FFIELD'
4174 ! include 'COMMON.CONTROL'
4175 ! include 'COMMON.SETUP'
4176 real(kind=8),dimension(3) :: u,ud
4178 integer :: i,j,iti,nbi,k
4179 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
4184 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
4185 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
4187 do i=ibondp_start,ibondp_end
4188 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4189 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4190 !C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4192 !C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
4193 !C *dc(j,i-1)/vbld(i)
4195 !C if (energy_dec) write(iout,*) &
4196 !C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4197 diff = vbld(i)-vbldpDUM
4199 diff = vbld(i)-vbldp0
4201 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
4202 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4205 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4207 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4210 estr=0.5d0*AKP*estr+estr1
4212 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4214 do i=ibond_start,ibond_end
4216 if (iti.ne.10 .and. iti.ne.ntyp1) then
4219 diff=vbld(i+nres)-vbldsc0(1,iti)
4220 if (energy_dec) write (iout,*) &
4221 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
4222 AKSC(1,iti),AKSC(1,iti)*diff*diff
4223 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4225 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4229 diff=vbld(i+nres)-vbldsc0(j,iti)
4230 ud(j)=aksc(j,iti)*diff
4231 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4245 uprod2=uprod2*u(k)*u(k)
4249 usumsqder=usumsqder+ud(j)*uprod2
4251 estr=estr+uprod/usum
4253 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4259 end subroutine ebond
4261 !-----------------------------------------------------------------------------
4262 subroutine ebend(etheta)
4264 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4265 ! angles gamma and its derivatives in consecutive thetas and gammas.
4268 ! implicit real*8 (a-h,o-z)
4269 ! include 'DIMENSIONS'
4270 ! include 'COMMON.LOCAL'
4271 ! include 'COMMON.GEO'
4272 ! include 'COMMON.INTERACT'
4273 ! include 'COMMON.DERIV'
4274 ! include 'COMMON.VAR'
4275 ! include 'COMMON.CHAIN'
4276 ! include 'COMMON.IOUNITS'
4277 ! include 'COMMON.NAMES'
4278 ! include 'COMMON.FFIELD'
4279 ! include 'COMMON.CONTROL'
4280 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
4281 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4282 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
4284 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
4285 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4286 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4288 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
4290 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
4291 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
4292 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
4293 real(kind=8),dimension(2) :: y,z
4296 ! time11=dexp(-2*time)
4299 ! write (*,'(a,i2)') 'EBEND ICG=',icg
4300 do i=ithet_start,ithet_end
4301 if (itype(i-1).eq.ntyp1) cycle
4302 ! Zero the energy function and its derivative at 0 or pi.
4303 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4305 ichir1=isign(1,itype(i-2))
4306 ichir2=isign(1,itype(i))
4307 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4308 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4309 if (itype(i-1).eq.10) then
4310 itype1=isign(10,itype(i-2))
4311 ichir11=isign(1,itype(i-2))
4312 ichir12=isign(1,itype(i-2))
4313 itype2=isign(10,itype(i))
4314 ichir21=isign(1,itype(i))
4315 ichir22=isign(1,itype(i))
4318 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4321 if (phii.ne.phii) phii=150.0
4331 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4334 if (phii1.ne.phii1) phii1=150.0
4346 ! Calculate the "mean" value of theta from the part of the distribution
4347 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4348 ! In following comments this theta will be referred to as t_c.
4349 thet_pred_mean=0.0d0
4351 athetk=athet(k,it,ichir1,ichir2)
4352 bthetk=bthet(k,it,ichir1,ichir2)
4354 athetk=athet(k,itype1,ichir11,ichir12)
4355 bthetk=bthet(k,itype2,ichir21,ichir22)
4357 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4359 dthett=thet_pred_mean*ssd
4360 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4361 ! Derivatives of the "mean" values in gamma1 and gamma2.
4362 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
4363 +athet(2,it,ichir1,ichir2)*y(1))*ss
4364 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
4365 +bthet(2,it,ichir1,ichir2)*z(1))*ss
4367 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
4368 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
4369 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
4370 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4372 if (theta(i).gt.pi-delta) then
4373 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
4375 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4376 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4377 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
4379 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
4381 else if (theta(i).lt.delta) then
4382 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4383 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4384 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
4386 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4387 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
4390 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
4393 etheta=etheta+ethetai
4394 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
4396 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4397 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4398 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4400 ! Ufff.... We've done all this!!!
4402 end subroutine ebend
4403 !-----------------------------------------------------------------------------
4404 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
4407 ! implicit real*8 (a-h,o-z)
4408 ! include 'DIMENSIONS'
4409 ! include 'COMMON.LOCAL'
4410 ! include 'COMMON.IOUNITS'
4411 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
4412 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4413 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
4415 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
4417 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
4418 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4419 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4421 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
4422 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
4424 ! Calculate the contributions to both Gaussian lobes.
4425 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4426 ! The "polynomial part" of the "standard deviation" of this part of
4430 sig=sig*thet_pred_mean+polthet(j,it)
4432 ! Derivative of the "interior part" of the "standard deviation of the"
4433 ! gamma-dependent Gaussian lobe in t_c.
4434 sigtc=3*polthet(3,it)
4436 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4439 ! Set the parameters of both Gaussian lobes of the distribution.
4440 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4441 fac=sig*sig+sigc0(it)
4444 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4445 sigsqtc=-4.0D0*sigcsq*sigtc
4446 ! print *,i,sig,sigtc,sigsqtc
4447 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
4448 sigtc=-sigtc/(fac*fac)
4449 ! Following variable is sigma(t_c)**(-2)
4450 sigcsq=sigcsq*sigcsq
4452 sig0inv=1.0D0/sig0i**2
4453 delthec=thetai-thet_pred_mean
4454 delthe0=thetai-theta0i
4455 term1=-0.5D0*sigcsq*delthec*delthec
4456 term2=-0.5D0*sig0inv*delthe0*delthe0
4457 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4458 ! NaNs in taking the logarithm. We extract the largest exponent which is added
4459 ! to the energy (this being the log of the distribution) at the end of energy
4460 ! term evaluation for this virtual-bond angle.
4461 if (term1.gt.term2) then
4463 term2=dexp(term2-termm)
4467 term1=dexp(term1-termm)
4470 ! The ratio between the gamma-independent and gamma-dependent lobes of
4471 ! the distribution is a Gaussian function of thet_pred_mean too.
4472 diffak=gthet(2,it)-thet_pred_mean
4473 ratak=diffak/gthet(3,it)**2
4474 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4475 ! Let's differentiate it in thet_pred_mean NOW.
4477 ! Now put together the distribution terms to make complete distribution.
4478 termexp=term1+ak*term2
4479 termpre=sigc+ak*sig0i
4480 ! Contribution of the bending energy from this theta is just the -log of
4481 ! the sum of the contributions from the two lobes and the pre-exponential
4482 ! factor. Simple enough, isn't it?
4483 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4484 ! NOW the derivatives!!!
4485 ! 6/6/97 Take into account the deformation.
4486 E_theta=(delthec*sigcsq*term1 &
4487 +ak*delthe0*sig0inv*term2)/termexp
4488 E_tc=((sigtc+aktc*sig0i)/termpre &
4489 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
4490 aktc*term2)/termexp)
4492 end subroutine theteng
4494 !-----------------------------------------------------------------------------
4495 subroutine ebend(etheta)
4497 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4498 ! angles gamma and its derivatives in consecutive thetas and gammas.
4499 ! ab initio-derived potentials from
4500 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4502 ! implicit real*8 (a-h,o-z)
4503 ! include 'DIMENSIONS'
4504 ! include 'COMMON.LOCAL'
4505 ! include 'COMMON.GEO'
4506 ! include 'COMMON.INTERACT'
4507 ! include 'COMMON.DERIV'
4508 ! include 'COMMON.VAR'
4509 ! include 'COMMON.CHAIN'
4510 ! include 'COMMON.IOUNITS'
4511 ! include 'COMMON.NAMES'
4512 ! include 'COMMON.FFIELD'
4513 ! include 'COMMON.CONTROL'
4514 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
4515 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
4516 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
4517 logical :: lprn=.false., lprn1=.false.
4519 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
4520 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
4521 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl
4524 do i=ithet_start,ithet_end
4525 if (itype(i-1).eq.ntyp1) cycle
4526 if (itype(i-2).eq.ntyp1.or.itype(i).eq.ntyp1) cycle
4527 if (iabs(itype(i+1)).eq.20) iblock=2
4528 if (iabs(itype(i+1)).ne.20) iblock=1
4532 theti2=0.5d0*theta(i)
4533 ityp2=ithetyp((itype(i-1)))
4535 coskt(k)=dcos(k*theti2)
4536 sinkt(k)=dsin(k*theti2)
4538 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4541 if (phii.ne.phii) phii=150.0
4545 ityp1=ithetyp((itype(i-2)))
4546 ! propagation of chirality for glycine type
4548 cosph1(k)=dcos(k*phii)
4549 sinph1(k)=dsin(k*phii)
4553 ityp1=ithetyp(itype(i-2))
4559 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4562 if (phii1.ne.phii1) phii1=150.0
4567 ityp3=ithetyp((itype(i)))
4569 cosph2(k)=dcos(k*phii1)
4570 sinph2(k)=dsin(k*phii1)
4574 ityp3=ithetyp(itype(i))
4580 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4583 ccl=cosph1(l)*cosph2(k-l)
4584 ssl=sinph1(l)*sinph2(k-l)
4585 scl=sinph1(l)*cosph2(k-l)
4586 csl=cosph1(l)*sinph2(k-l)
4587 cosph1ph2(l,k)=ccl-ssl
4588 cosph1ph2(k,l)=ccl+ssl
4589 sinph1ph2(l,k)=scl+csl
4590 sinph1ph2(k,l)=scl-csl
4594 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
4595 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4596 write (iout,*) "coskt and sinkt"
4598 write (iout,*) k,coskt(k),sinkt(k)
4602 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4603 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
4606 write (iout,*) "k",k,&
4607 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
4611 write (iout,*) "cosph and sinph"
4613 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4615 write (iout,*) "cosph1ph2 and sinph2ph2"
4618 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
4619 sinph1ph2(l,k),sinph1ph2(k,l)
4622 write(iout,*) "ethetai",ethetai
4626 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
4627 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
4628 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
4629 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4630 ethetai=ethetai+sinkt(m)*aux
4631 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4632 dephii=dephii+k*sinkt(m)* &
4633 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
4634 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4635 dephii1=dephii1+k*sinkt(m)* &
4636 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
4637 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4639 write (iout,*) "m",m," k",k," bbthet", &
4640 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
4641 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
4642 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
4643 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4647 write(iout,*) "ethetai",ethetai
4651 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
4652 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
4653 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
4654 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4655 ethetai=ethetai+sinkt(m)*aux
4656 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4657 dephii=dephii+l*sinkt(m)* &
4658 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
4659 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
4660 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
4661 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4662 dephii1=dephii1+(k-l)*sinkt(m)* &
4663 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
4664 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
4665 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
4666 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4668 write (iout,*) "m",m," k",k," l",l," ffthet",&
4669 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
4670 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
4671 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
4672 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
4674 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
4675 cosph1ph2(k,l)*sinkt(m),&
4676 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4684 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
4685 i,theta(i)*rad2deg,phii*rad2deg,&
4686 phii1*rad2deg,ethetai
4688 etheta=etheta+ethetai
4689 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
4691 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4692 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4693 gloc(nphi+i-2,icg)=wang*dethetai
4696 end subroutine ebend
4699 !-----------------------------------------------------------------------------
4700 subroutine esc(escloc)
4701 ! Calculate the local energy of a side chain and its derivatives in the
4702 ! corresponding virtual-bond valence angles THETA and the spherical angles
4706 ! implicit real*8 (a-h,o-z)
4707 ! include 'DIMENSIONS'
4708 ! include 'COMMON.GEO'
4709 ! include 'COMMON.LOCAL'
4710 ! include 'COMMON.VAR'
4711 ! include 'COMMON.INTERACT'
4712 ! include 'COMMON.DERIV'
4713 ! include 'COMMON.CHAIN'
4714 ! include 'COMMON.IOUNITS'
4715 ! include 'COMMON.NAMES'
4716 ! include 'COMMON.FFIELD'
4717 ! include 'COMMON.CONTROL'
4718 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
4719 ddersc0,ddummy,xtemp,temp
4720 !el real(kind=8) :: time11,time12,time112,theti
4721 real(kind=8) :: escloc,delta
4722 !el integer :: it,nlobit
4723 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4726 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
4727 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
4730 ! write (iout,'(a)') 'ESC'
4731 do i=loc_start,loc_end
4733 if (it.eq.ntyp1) cycle
4734 if (it.eq.10) goto 1
4735 nlobit=nlob(iabs(it))
4736 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
4737 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4738 theti=theta(i+1)-pipol
4743 if (x(2).gt.pi-delta) then
4747 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4749 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4750 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
4752 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
4753 ddersc0(1),dersc(1))
4754 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
4755 ddersc0(3),dersc(3))
4757 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4759 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4760 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
4761 dersc0(2),esclocbi,dersc02)
4762 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
4764 call splinthet(x(2),0.5d0*delta,ss,ssd)
4769 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4771 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4772 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4774 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4776 ! write (iout,*) escloci
4777 else if (x(2).lt.delta) then
4781 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4783 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4784 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
4786 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
4787 ddersc0(1),dersc(1))
4788 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
4789 ddersc0(3),dersc(3))
4791 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4793 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4794 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
4795 dersc0(2),esclocbi,dersc02)
4796 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
4801 call splinthet(x(2),0.5d0*delta,ss,ssd)
4803 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4805 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4806 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4808 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4809 ! write (iout,*) escloci
4811 call enesc(x,escloci,dersc,ddummy,.false.)
4814 escloc=escloc+escloci
4815 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
4817 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4819 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
4821 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4822 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4827 !-----------------------------------------------------------------------------
4828 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4831 ! implicit real*8 (a-h,o-z)
4832 ! include 'DIMENSIONS'
4833 ! include 'COMMON.GEO'
4834 ! include 'COMMON.LOCAL'
4835 ! include 'COMMON.IOUNITS'
4836 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4837 real(kind=8),dimension(3) :: x,z,dersc,ddersc
4838 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
4839 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
4840 real(kind=8) :: escloci
4843 integer :: j,iii,l,k !el,it,nlobit
4844 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
4845 !el time11,time12,time112
4846 ! write (iout,*) 'it=',it,' nlobit=',nlobit
4850 if (mixed) ddersc(j)=0.0d0
4854 ! Because of periodicity of the dependence of the SC energy in omega we have
4855 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4856 ! To avoid underflows, first compute & store the exponents.
4864 z(k)=x(k)-censc(k,j,it)
4869 Axk=Axk+gaussc(l,k,j,it)*z(l)
4875 expfac=expfac+Ax(k,j,iii)*z(k)
4883 ! As in the case of ebend, we want to avoid underflows in exponentiation and
4884 ! subsequent NaNs and INFs in energy calculation.
4885 ! Find the largest exponent
4889 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4893 !d print *,'it=',it,' emin=',emin
4895 ! Compute the contribution to SC energy and derivatives
4900 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
4901 if(adexp.ne.adexp) adexp=1.0
4904 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4906 !d print *,'j=',j,' expfac=',expfac
4907 escloc_i=escloc_i+expfac
4909 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4913 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
4914 +gaussc(k,2,j,it))*expfac
4921 dersc(1)=dersc(1)/cos(theti)**2
4922 ddersc(1)=ddersc(1)/cos(theti)**2
4925 escloci=-(dlog(escloc_i)-emin)
4927 dersc(j)=dersc(j)/escloc_i
4931 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4935 end subroutine enesc
4936 !-----------------------------------------------------------------------------
4937 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4940 ! implicit real*8 (a-h,o-z)
4941 ! include 'DIMENSIONS'
4942 ! include 'COMMON.GEO'
4943 ! include 'COMMON.LOCAL'
4944 ! include 'COMMON.IOUNITS'
4945 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4946 real(kind=8),dimension(3) :: x,z,dersc
4947 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
4948 real(kind=8),dimension(nlobit) :: contr !(maxlob)
4949 real(kind=8) :: escloci,dersc12,emin
4952 integer :: j,k,l !el,it,nlobit
4953 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
4963 z(k)=x(k)-censc(k,j,it)
4969 Axk=Axk+gaussc(l,k,j,it)*z(l)
4975 expfac=expfac+Ax(k,j)*z(k)
4980 ! As in the case of ebend, we want to avoid underflows in exponentiation and
4981 ! subsequent NaNs and INFs in energy calculation.
4982 ! Find the largest exponent
4985 if (emin.gt.contr(j)) emin=contr(j)
4989 ! Compute the contribution to SC energy and derivatives
4993 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4994 escloc_i=escloc_i+expfac
4996 dersc(k)=dersc(k)+Ax(k,j)*expfac
4998 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
4999 +gaussc(1,2,j,it))*expfac
5003 dersc(1)=dersc(1)/cos(theti)**2
5004 dersc12=dersc12/cos(theti)**2
5005 escloci=-(dlog(escloc_i)-emin)
5007 dersc(j)=dersc(j)/escloc_i
5009 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5011 end subroutine enesc_bound
5013 !-----------------------------------------------------------------------------
5014 subroutine esc(escloc)
5015 ! Calculate the local energy of a side chain and its derivatives in the
5016 ! corresponding virtual-bond valence angles THETA and the spherical angles
5017 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
5018 ! added by Urszula Kozlowska. 07/11/2007
5021 ! implicit real*8 (a-h,o-z)
5022 ! include 'DIMENSIONS'
5023 ! include 'COMMON.GEO'
5024 ! include 'COMMON.LOCAL'
5025 ! include 'COMMON.VAR'
5026 ! include 'COMMON.SCROT'
5027 ! include 'COMMON.INTERACT'
5028 ! include 'COMMON.DERIV'
5029 ! include 'COMMON.CHAIN'
5030 ! include 'COMMON.IOUNITS'
5031 ! include 'COMMON.NAMES'
5032 ! include 'COMMON.FFIELD'
5033 ! include 'COMMON.CONTROL'
5034 ! include 'COMMON.VECTORS'
5035 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
5036 real(kind=8),dimension(65) :: x
5037 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
5038 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
5039 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
5040 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
5041 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
5043 integer :: i,j,k !el,it,nlobit
5044 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
5045 !el real(kind=8) :: time11,time12,time112,theti
5046 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5047 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
5048 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
5049 sumene1x,sumene2x,sumene3x,sumene4x,&
5050 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
5053 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
5054 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
5057 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
5061 do i=loc_start,loc_end
5062 if (itype(i).eq.ntyp1) cycle
5063 costtab(i+1) =dcos(theta(i+1))
5064 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5065 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5066 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5067 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5068 cosfac=dsqrt(cosfac2)
5069 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5070 sinfac=dsqrt(sinfac2)
5072 if (it.eq.10) goto 1
5074 ! Compute the axes of tghe local cartesian coordinates system; store in
5075 ! x_prime, y_prime and z_prime
5082 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5083 ! & dc_norm(3,i+nres)
5085 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5086 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5089 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5092 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
5093 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
5094 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
5095 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5096 ! & " xy",scalar(x_prime(1),y_prime(1)),
5097 ! & " xz",scalar(x_prime(1),z_prime(1)),
5098 ! & " yy",scalar(y_prime(1),y_prime(1)),
5099 ! & " yz",scalar(y_prime(1),z_prime(1)),
5100 ! & " zz",scalar(z_prime(1),z_prime(1))
5102 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5103 ! to local coordinate system. Store in xx, yy, zz.
5109 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5110 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5111 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5118 ! Compute the energy of the ith side cbain
5120 ! write (2,*) "xx",xx," yy",yy," zz",zz
5123 x(j) = sc_parmin(j,it)
5126 !c diagnostics - remove later
5128 yy1 = dsin(alph(2))*dcos(omeg(2))
5129 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5130 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
5131 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
5133 !," --- ", xx_w,yy_w,zz_w
5136 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
5137 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
5139 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
5140 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
5142 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
5143 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
5144 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
5145 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
5146 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
5148 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
5149 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
5150 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
5151 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
5152 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
5154 dsc_i = 0.743d0+x(61)
5156 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5157 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5158 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5159 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5160 s1=(1+x(63))/(0.1d0 + dscp1)
5161 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5162 s2=(1+x(65))/(0.1d0 + dscp2)
5163 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5164 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
5165 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5166 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5168 ! & dscp1,dscp2,sumene
5169 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5170 escloc = escloc + sumene
5171 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5176 ! This section to check the numerical derivatives of the energy of ith side
5177 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5178 ! #define DEBUG in the code to turn it on.
5180 write (2,*) "sumene =",sumene
5184 write (2,*) xx,yy,zz
5185 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5186 de_dxx_num=(sumenep-sumene)/aincr
5188 write (2,*) "xx+ sumene from enesc=",sumenep
5191 write (2,*) xx,yy,zz
5192 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5193 de_dyy_num=(sumenep-sumene)/aincr
5195 write (2,*) "yy+ sumene from enesc=",sumenep
5198 write (2,*) xx,yy,zz
5199 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5200 de_dzz_num=(sumenep-sumene)/aincr
5202 write (2,*) "zz+ sumene from enesc=",sumenep
5203 costsave=cost2tab(i+1)
5204 sintsave=sint2tab(i+1)
5205 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5206 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5207 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5208 de_dt_num=(sumenep-sumene)/aincr
5209 write (2,*) " t+ sumene from enesc=",sumenep
5210 cost2tab(i+1)=costsave
5211 sint2tab(i+1)=sintsave
5212 ! End of diagnostics section.
5215 ! Compute the gradient of esc
5217 ! zz=zz*dsign(1.0,dfloat(itype(i)))
5218 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5219 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5220 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5221 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5222 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5223 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5224 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5225 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5226 pom1=(sumene3*sint2tab(i+1)+sumene1) &
5227 *(pom_s1/dscp1+pom_s16*dscp1**4)
5228 pom2=(sumene4*cost2tab(i+1)+sumene2) &
5229 *(pom_s2/dscp2+pom_s26*dscp2**4)
5230 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5231 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
5232 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
5234 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5235 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
5236 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
5238 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
5239 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
5242 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5245 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5246 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
5247 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
5249 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5250 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
5251 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
5252 +x(59)*zz**2 +x(60)*xx*zz
5253 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
5254 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
5257 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5260 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
5261 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
5262 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
5263 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
5264 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
5265 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
5266 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
5267 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5269 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5272 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
5273 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
5274 +pom1*pom_dt1+pom2*pom_dt2
5276 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5280 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5281 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5282 cosfac2xx=cosfac2*xx
5283 sinfac2yy=sinfac2*yy
5285 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
5287 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
5289 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5290 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5291 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5292 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5293 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5294 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5295 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5296 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5297 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5298 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5302 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
5303 *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5304 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
5305 *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5308 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5309 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5310 dZZ_XYZ(k)=vbld_inv(i+nres)* &
5311 (z_prime(k)-zz*dC_norm(k,i+nres))
5313 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5314 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5318 dXX_Ctab(k,i)=dXX_Ci(k)
5319 dXX_C1tab(k,i)=dXX_Ci1(k)
5320 dYY_Ctab(k,i)=dYY_Ci(k)
5321 dYY_C1tab(k,i)=dYY_Ci1(k)
5322 dZZ_Ctab(k,i)=dZZ_Ci(k)
5323 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5324 dXX_XYZtab(k,i)=dXX_XYZ(k)
5325 dYY_XYZtab(k,i)=dYY_XYZ(k)
5326 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5330 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5331 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5332 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5333 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
5334 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5336 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5337 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5338 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
5339 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5340 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
5341 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5342 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
5343 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5345 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5346 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5348 ! to check gradient call subroutine check_grad
5354 !-----------------------------------------------------------------------------
5355 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
5357 real(kind=8),dimension(65) :: x
5358 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
5359 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5361 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
5362 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
5364 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
5365 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
5367 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
5368 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
5369 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
5370 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
5371 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
5373 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
5374 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
5375 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
5376 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
5377 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
5379 dsc_i = 0.743d0+x(61)
5381 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5382 *(xx*cost2+yy*sint2))
5383 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5384 *(xx*cost2-yy*sint2))
5385 s1=(1+x(63))/(0.1d0 + dscp1)
5386 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5387 s2=(1+x(65))/(0.1d0 + dscp2)
5388 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5389 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
5390 + (sumene4*cost2 +sumene2)*(s2+s2_6)
5395 !-----------------------------------------------------------------------------
5396 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5398 ! This procedure calculates two-body contact function g(rij) and its derivative:
5401 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5404 ! where x=(rij-r0ij)/delta
5406 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5409 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
5410 real(kind=8) :: x,x2,x4,delta
5414 if (x.lt.-1.0D0) then
5417 else if (x.le.1.0D0) then
5420 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5421 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5427 end subroutine gcont
5428 !-----------------------------------------------------------------------------
5429 subroutine splinthet(theti,delta,ss,ssder)
5430 ! implicit real*8 (a-h,o-z)
5431 ! include 'DIMENSIONS'
5432 ! include 'COMMON.VAR'
5433 ! include 'COMMON.GEO'
5434 real(kind=8) :: theti,delta,ss,ssder
5435 real(kind=8) :: thetup,thetlow
5438 if (theti.gt.pipol) then
5439 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5441 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5445 end subroutine splinthet
5446 !-----------------------------------------------------------------------------
5447 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5449 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
5450 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
5451 a1=fprim0*delta/(f1-f0)
5457 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5458 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5460 end subroutine spline1
5461 !-----------------------------------------------------------------------------
5462 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5464 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
5465 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
5470 a2=3*(f1x-f0x)-2*fprim0x*delta
5471 a3=fprim0x*delta-2*(f1x-f0x)
5472 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5474 end subroutine spline2
5475 !-----------------------------------------------------------------------------
5477 !-----------------------------------------------------------------------------
5478 subroutine etor(etors,edihcnstr)
5479 ! implicit real*8 (a-h,o-z)
5480 ! include 'DIMENSIONS'
5481 ! include 'COMMON.VAR'
5482 ! include 'COMMON.GEO'
5483 ! include 'COMMON.LOCAL'
5484 ! include 'COMMON.TORSION'
5485 ! include 'COMMON.INTERACT'
5486 ! include 'COMMON.DERIV'
5487 ! include 'COMMON.CHAIN'
5488 ! include 'COMMON.NAMES'
5489 ! include 'COMMON.IOUNITS'
5490 ! include 'COMMON.FFIELD'
5491 ! include 'COMMON.TORCNSTR'
5492 ! include 'COMMON.CONTROL'
5493 real(kind=8) :: etors,edihcnstr
5497 real(kind=8) :: phii,fac,etors_ii
5499 ! Set lprn=.true. for debugging
5503 do i=iphi_start,iphi_end
5505 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 &
5506 .or. itype(i).eq.ntyp1) cycle
5507 itori=itortyp(itype(i-2))
5508 itori1=itortyp(itype(i-1))
5511 ! Proline-Proline pair is a special case...
5512 if (itori.eq.3 .and. itori1.eq.3) then
5513 if (phii.gt.-dwapi3) then
5515 fac=1.0D0/(1.0D0-cosphi)
5516 etorsi=v1(1,3,3)*fac
5517 etorsi=etorsi+etorsi
5518 etors=etors+etorsi-v1(1,3,3)
5519 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5520 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5523 v1ij=v1(j+1,itori,itori1)
5524 v2ij=v2(j+1,itori,itori1)
5527 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5528 if (energy_dec) etors_ii=etors_ii+ &
5529 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5530 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5534 v1ij=v1(j,itori,itori1)
5535 v2ij=v2(j,itori,itori1)
5538 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5539 if (energy_dec) etors_ii=etors_ii+ &
5540 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5541 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5544 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5547 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5548 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
5549 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5550 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5551 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5553 ! 6/20/98 - dihedral angle constraints
5556 itori=idih_constr(i)
5559 if (difi.gt.drange(i)) then
5561 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5562 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5563 else if (difi.lt.-drange(i)) then
5565 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5566 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5568 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5569 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5571 ! write (iout,*) 'edihcnstr',edihcnstr
5574 !-----------------------------------------------------------------------------
5575 subroutine etor_d(etors_d)
5576 real(kind=8) :: etors_d
5579 end subroutine etor_d
5581 !-----------------------------------------------------------------------------
5582 subroutine etor(etors,edihcnstr)
5583 ! implicit real*8 (a-h,o-z)
5584 ! include 'DIMENSIONS'
5585 ! include 'COMMON.VAR'
5586 ! include 'COMMON.GEO'
5587 ! include 'COMMON.LOCAL'
5588 ! include 'COMMON.TORSION'
5589 ! include 'COMMON.INTERACT'
5590 ! include 'COMMON.DERIV'
5591 ! include 'COMMON.CHAIN'
5592 ! include 'COMMON.NAMES'
5593 ! include 'COMMON.IOUNITS'
5594 ! include 'COMMON.FFIELD'
5595 ! include 'COMMON.TORCNSTR'
5596 ! include 'COMMON.CONTROL'
5597 real(kind=8) :: etors,edihcnstr
5600 integer :: i,j,iblock,itori,itori1
5601 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
5602 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
5603 ! Set lprn=.true. for debugging
5607 do i=iphi_start,iphi_end
5608 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
5609 .or. itype(i-3).eq.ntyp1 &
5610 .or. itype(i).eq.ntyp1) cycle
5612 if (iabs(itype(i)).eq.20) then
5617 itori=itortyp(itype(i-2))
5618 itori1=itortyp(itype(i-1))
5621 ! Regular cosine and sine terms
5622 do j=1,nterm(itori,itori1,iblock)
5623 v1ij=v1(j,itori,itori1,iblock)
5624 v2ij=v2(j,itori,itori1,iblock)
5627 etors=etors+v1ij*cosphi+v2ij*sinphi
5628 if (energy_dec) etors_ii=etors_ii+ &
5629 v1ij*cosphi+v2ij*sinphi
5630 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5634 ! E = SUM ----------------------------------- - v1
5635 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5637 cosphi=dcos(0.5d0*phii)
5638 sinphi=dsin(0.5d0*phii)
5639 do j=1,nlor(itori,itori1,iblock)
5640 vl1ij=vlor1(j,itori,itori1)
5641 vl2ij=vlor2(j,itori,itori1)
5642 vl3ij=vlor3(j,itori,itori1)
5643 pom=vl2ij*cosphi+vl3ij*sinphi
5644 pom1=1.0d0/(pom*pom+1.0d0)
5645 etors=etors+vl1ij*pom1
5646 if (energy_dec) etors_ii=etors_ii+ &
5649 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5651 ! Subtract the constant term
5652 etors=etors-v0(itori,itori1,iblock)
5653 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5654 'etor',i,etors_ii-v0(itori,itori1,iblock)
5656 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5657 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
5658 (v1(j,itori,itori1,iblock),j=1,6),&
5659 (v2(j,itori,itori1,iblock),j=1,6)
5660 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5661 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5663 ! 6/20/98 - dihedral angle constraints
5665 ! do i=1,ndih_constr
5666 do i=idihconstr_start,idihconstr_end
5667 itori=idih_constr(i)
5669 difi=pinorm(phii-phi0(i))
5670 if (difi.gt.drange(i)) then
5672 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5673 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5674 else if (difi.lt.-drange(i)) then
5676 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5677 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5681 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5682 !d & rad2deg*phi0(i), rad2deg*drange(i),
5683 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5685 !d write (iout,*) 'edihcnstr',edihcnstr
5688 !-----------------------------------------------------------------------------
5689 subroutine etor_d(etors_d)
5690 ! 6/23/01 Compute double torsional energy
5691 ! implicit real*8 (a-h,o-z)
5692 ! include 'DIMENSIONS'
5693 ! include 'COMMON.VAR'
5694 ! include 'COMMON.GEO'
5695 ! include 'COMMON.LOCAL'
5696 ! include 'COMMON.TORSION'
5697 ! include 'COMMON.INTERACT'
5698 ! include 'COMMON.DERIV'
5699 ! include 'COMMON.CHAIN'
5700 ! include 'COMMON.NAMES'
5701 ! include 'COMMON.IOUNITS'
5702 ! include 'COMMON.FFIELD'
5703 ! include 'COMMON.TORCNSTR'
5704 real(kind=8) :: etors_d,etors_d_ii
5707 integer :: i,j,k,l,itori,itori1,itori2,iblock
5708 real(kind=8) :: phii,phii1,gloci1,gloci2,&
5709 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
5710 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
5711 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
5712 ! Set lprn=.true. for debugging
5716 ! write(iout,*) "a tu??"
5717 do i=iphid_start,iphid_end
5719 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
5720 .or. itype(i-3).eq.ntyp1 &
5721 .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5722 itori=itortyp(itype(i-2))
5723 itori1=itortyp(itype(i-1))
5724 itori2=itortyp(itype(i))
5730 if (iabs(itype(i+1)).eq.20) iblock=2
5732 ! Regular cosine and sine terms
5733 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5734 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5735 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5736 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5737 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5738 cosphi1=dcos(j*phii)
5739 sinphi1=dsin(j*phii)
5740 cosphi2=dcos(j*phii1)
5741 sinphi2=dsin(j*phii1)
5742 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
5743 v2cij*cosphi2+v2sij*sinphi2
5744 if (energy_dec) etors_d_ii=etors_d_ii+ &
5745 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
5746 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5747 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5749 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5751 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5752 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5753 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5754 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5755 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5756 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5757 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5758 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5759 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
5760 v1sdij*sinphi1p2+v2sdij*sinphi1m2
5761 if (energy_dec) etors_d_ii=etors_d_ii+ &
5762 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
5763 v1sdij*sinphi1p2+v2sdij*sinphi1m2
5764 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
5765 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5766 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
5767 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5770 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5771 'etor_d',i,etors_d_ii
5772 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5773 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5776 end subroutine etor_d
5778 !-----------------------------------------------------------------------------
5779 subroutine eback_sc_corr(esccor)
5780 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
5781 ! conformational states; temporarily implemented as differences
5782 ! between UNRES torsional potentials (dependent on three types of
5783 ! residues) and the torsional potentials dependent on all 20 types
5784 ! of residues computed from AM1 energy surfaces of terminally-blocked
5785 ! amino-acid residues.
5786 ! implicit real*8 (a-h,o-z)
5787 ! include 'DIMENSIONS'
5788 ! include 'COMMON.VAR'
5789 ! include 'COMMON.GEO'
5790 ! include 'COMMON.LOCAL'
5791 ! include 'COMMON.TORSION'
5792 ! include 'COMMON.SCCOR'
5793 ! include 'COMMON.INTERACT'
5794 ! include 'COMMON.DERIV'
5795 ! include 'COMMON.CHAIN'
5796 ! include 'COMMON.NAMES'
5797 ! include 'COMMON.IOUNITS'
5798 ! include 'COMMON.FFIELD'
5799 ! include 'COMMON.CONTROL'
5800 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
5803 integer :: i,interty,j,isccori,isccori1,intertyp
5804 ! Set lprn=.true. for debugging
5807 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5809 do i=itau_start,itau_end
5810 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5812 isccori=isccortyp(itype(i-2))
5813 isccori1=isccortyp(itype(i-1))
5815 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5817 do intertyp=1,3 !intertyp
5819 !c Added 09 May 2012 (Adasko)
5820 !c Intertyp means interaction type of backbone mainchain correlation:
5821 ! 1 = SC...Ca...Ca...Ca
5822 ! 2 = Ca...Ca...Ca...SC
5823 ! 3 = SC...Ca...Ca...SCi
5825 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. &
5826 (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or. &
5827 (itype(i-1).eq.ntyp1))) &
5828 .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) &
5829 .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1) &
5830 .or.(itype(i).eq.ntyp1))) &
5831 .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. &
5832 (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. &
5833 (itype(i-3).eq.ntyp1)))) cycle
5834 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5835 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1)) &
5837 do j=1,nterm_sccor(isccori,isccori1)
5838 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5839 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5840 cosphi=dcos(j*tauangle(intertyp,i))
5841 sinphi=dsin(j*tauangle(intertyp,i))
5842 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
5843 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5844 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5846 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
5847 'esccor',i,intertyp,esccor_ii
5848 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5849 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5851 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5852 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,&
5853 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
5854 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5855 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5860 end subroutine eback_sc_corr
5861 !-----------------------------------------------------------------------------
5862 subroutine multibody(ecorr)
5863 ! This subroutine calculates multi-body contributions to energy following
5864 ! the idea of Skolnick et al. If side chains I and J make a contact and
5865 ! at the same time side chains I+1 and J+1 make a contact, an extra
5866 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5867 ! implicit real*8 (a-h,o-z)
5868 ! include 'DIMENSIONS'
5869 ! include 'COMMON.IOUNITS'
5870 ! include 'COMMON.DERIV'
5871 ! include 'COMMON.INTERACT'
5872 ! include 'COMMON.CONTACTS'
5873 real(kind=8),dimension(3) :: gx,gx1
5875 real(kind=8) :: ecorr
5876 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
5877 ! Set lprn=.true. for debugging
5881 write (iout,'(a)') 'Contact function values:'
5883 write (iout,'(i2,20(1x,i2,f10.5))') &
5884 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5889 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
5890 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
5902 num_conti=num_cont(i)
5903 num_conti1=num_cont(i1)
5908 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5909 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5910 !d & ' ishift=',ishift
5911 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5912 ! The system gains extra energy.
5913 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5914 endif ! j1==j+-ishift
5922 end subroutine multibody
5923 !-----------------------------------------------------------------------------
5924 real(kind=8) function esccorr(i,j,k,l,jj,kk)
5925 ! implicit real*8 (a-h,o-z)
5926 ! include 'DIMENSIONS'
5927 ! include 'COMMON.IOUNITS'
5928 ! include 'COMMON.DERIV'
5929 ! include 'COMMON.INTERACT'
5930 ! include 'COMMON.CONTACTS'
5931 real(kind=8),dimension(3) :: gx,gx1
5933 integer :: i,j,k,l,jj,kk,m,ll
5934 real(kind=8) :: eij,ekl
5938 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5939 ! Calculate the multi-body contribution to energy.
5940 ! Calculate multi-body contributions to the gradient.
5941 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5942 !d & k,l,(gacont(m,kk,k),m=1,3)
5944 gx(m) =ekl*gacont(m,jj,i)
5945 gx1(m)=eij*gacont(m,kk,k)
5946 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5947 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5948 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5949 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5953 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5958 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5963 end function esccorr
5964 !-----------------------------------------------------------------------------
5965 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5966 ! This subroutine calculates multi-body contributions to hydrogen-bonding
5967 ! implicit real*8 (a-h,o-z)
5968 ! include 'DIMENSIONS'
5969 ! include 'COMMON.IOUNITS'
5972 ! integer :: maxconts !max_cont=maxconts =nres/4
5973 integer,parameter :: max_dim=26
5974 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5975 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
5976 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
5977 !el common /przechowalnia/ zapas
5978 integer :: status(MPI_STATUS_SIZE)
5979 integer,dimension((nres/4)*2) :: req !maxconts*2
5980 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
5982 ! include 'COMMON.SETUP'
5983 ! include 'COMMON.FFIELD'
5984 ! include 'COMMON.DERIV'
5985 ! include 'COMMON.INTERACT'
5986 ! include 'COMMON.CONTACTS'
5987 ! include 'COMMON.CONTROL'
5988 ! include 'COMMON.LOCAL'
5989 real(kind=8),dimension(3) :: gx,gx1
5990 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
5991 logical :: lprn,ldone
5993 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
5994 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
5996 ! Set lprn=.true. for debugging
6000 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
6003 if (nfgtasks.le.1) goto 30
6005 write (iout,'(a)') 'Contact function values before RECEIVE:'
6007 write (iout,'(2i3,50(1x,i2,f5.2))') &
6008 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6013 do i=1,ntask_cont_from
6016 do i=1,ntask_cont_to
6019 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6021 ! Make the list of contacts to send to send to other procesors
6022 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6024 do i=iturn3_start,iturn3_end
6025 ! write (iout,*) "make contact list turn3",i," num_cont",
6027 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6029 do i=iturn4_start,iturn4_end
6030 ! write (iout,*) "make contact list turn4",i," num_cont",
6032 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6036 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
6038 do j=1,num_cont_hb(i)
6041 iproc=iint_sent_local(k,jjc,ii)
6042 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6043 if (iproc.gt.0) then
6044 ncont_sent(iproc)=ncont_sent(iproc)+1
6045 nn=ncont_sent(iproc)
6047 zapas(2,nn,iproc)=jjc
6048 zapas(3,nn,iproc)=facont_hb(j,i)
6049 zapas(4,nn,iproc)=ees0p(j,i)
6050 zapas(5,nn,iproc)=ees0m(j,i)
6051 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6052 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6053 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6054 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6055 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6056 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6057 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6058 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6059 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6060 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6061 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6062 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6063 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6064 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6065 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6066 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6067 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6068 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6069 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6070 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6071 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6078 "Numbers of contacts to be sent to other processors",&
6079 (ncont_sent(i),i=1,ntask_cont_to)
6080 write (iout,*) "Contacts sent"
6081 do ii=1,ntask_cont_to
6083 iproc=itask_cont_to(ii)
6084 write (iout,*) nn," contacts to processor",iproc,&
6085 " of CONT_TO_COMM group"
6087 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6095 CorrelID1=nfgtasks+fg_rank+1
6097 ! Receive the numbers of needed contacts from other processors
6098 do ii=1,ntask_cont_from
6099 iproc=itask_cont_from(ii)
6101 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
6102 FG_COMM,req(ireq),IERR)
6104 ! write (iout,*) "IRECV ended"
6106 ! Send the number of contacts needed by other processors
6107 do ii=1,ntask_cont_to
6108 iproc=itask_cont_to(ii)
6110 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
6111 FG_COMM,req(ireq),IERR)
6113 ! write (iout,*) "ISEND ended"
6114 ! write (iout,*) "number of requests (nn)",ireq
6117 call MPI_Waitall(ireq,req,status_array,ierr)
6119 ! & "Numbers of contacts to be received from other processors",
6120 ! & (ncont_recv(i),i=1,ntask_cont_from)
6124 do ii=1,ntask_cont_from
6125 iproc=itask_cont_from(ii)
6127 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
6128 ! & " of CONT_TO_COMM group"
6132 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
6133 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6134 ! write (iout,*) "ireq,req",ireq,req(ireq)
6137 ! Send the contacts to processors that need them
6138 do ii=1,ntask_cont_to
6139 iproc=itask_cont_to(ii)
6141 ! write (iout,*) nn," contacts to processor",iproc,
6142 ! & " of CONT_TO_COMM group"
6145 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
6146 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6147 ! write (iout,*) "ireq,req",ireq,req(ireq)
6149 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6153 ! write (iout,*) "number of requests (contacts)",ireq
6154 ! write (iout,*) "req",(req(i),i=1,4)
6157 call MPI_Waitall(ireq,req,status_array,ierr)
6158 do iii=1,ntask_cont_from
6159 iproc=itask_cont_from(iii)
6162 write (iout,*) "Received",nn," contacts from processor",iproc,&
6163 " of CONT_FROM_COMM group"
6166 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6171 ii=zapas_recv(1,i,iii)
6172 ! Flag the received contacts to prevent double-counting
6173 jj=-zapas_recv(2,i,iii)
6174 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6176 nnn=num_cont_hb(ii)+1
6179 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6180 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6181 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6182 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6183 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6184 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6185 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6186 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6187 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6188 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6189 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6190 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6191 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6192 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6193 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6194 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6195 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6196 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6197 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6198 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6199 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6200 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6201 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6202 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6207 write (iout,'(a)') 'Contact function values after receive:'
6209 write (iout,'(2i3,50(1x,i3,f5.2))') &
6210 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6218 write (iout,'(a)') 'Contact function values:'
6220 write (iout,'(2i3,50(1x,i3,f5.2))') &
6221 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6227 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6228 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6229 ! Remove the loop below after debugging !!!
6236 ! Calculate the local-electrostatic correlation terms
6237 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6239 num_conti=num_cont_hb(i)
6240 num_conti1=num_cont_hb(i+1)
6247 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
6248 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
6249 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
6250 .or. j.lt.0 .and. j1.gt.0) .and. &
6251 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6252 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6253 ! The system gains extra energy.
6254 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6255 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
6256 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6258 else if (j1.eq.j) then
6259 ! Contacts I-J and I-(J+1) occur simultaneously.
6260 ! The system loses extra energy.
6261 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6266 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6267 ! & ' jj=',jj,' kk=',kk
6269 ! Contacts I-J and (I+1)-J occur simultaneously.
6270 ! The system loses extra energy.
6271 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6277 end subroutine multibody_hb
6278 !-----------------------------------------------------------------------------
6279 subroutine add_hb_contact(ii,jj,itask)
6280 ! implicit real*8 (a-h,o-z)
6281 ! include "DIMENSIONS"
6282 ! include "COMMON.IOUNITS"
6283 ! include "COMMON.CONTACTS"
6284 ! integer,parameter :: maxconts=nres/4
6285 integer,parameter :: max_dim=26
6286 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6287 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
6288 ! common /przechowalnia/ zapas
6289 integer :: i,j,ii,jj,iproc,nn,jjc
6290 integer,dimension(4) :: itask
6291 ! write (iout,*) "itask",itask
6294 if (iproc.gt.0) then
6295 do j=1,num_cont_hb(ii)
6297 ! write (iout,*) "i",ii," j",jj," jjc",jjc
6299 ncont_sent(iproc)=ncont_sent(iproc)+1
6300 nn=ncont_sent(iproc)
6301 zapas(1,nn,iproc)=ii
6302 zapas(2,nn,iproc)=jjc
6303 zapas(3,nn,iproc)=facont_hb(j,ii)
6304 zapas(4,nn,iproc)=ees0p(j,ii)
6305 zapas(5,nn,iproc)=ees0m(j,ii)
6306 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6307 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6308 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6309 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6310 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6311 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6312 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6313 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6314 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6315 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6316 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6317 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6318 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6319 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6320 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6321 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6322 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6323 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6324 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6325 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6326 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6333 end subroutine add_hb_contact
6334 !-----------------------------------------------------------------------------
6335 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
6336 ! This subroutine calculates multi-body contributions to hydrogen-bonding
6337 ! implicit real*8 (a-h,o-z)
6338 ! include 'DIMENSIONS'
6339 ! include 'COMMON.IOUNITS'
6340 integer,parameter :: max_dim=70
6343 ! integer :: maxconts !max_cont=maxconts=nres/4
6344 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6345 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
6346 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6347 ! common /przechowalnia/ zapas
6348 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
6349 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
6352 ! include 'COMMON.SETUP'
6353 ! include 'COMMON.FFIELD'
6354 ! include 'COMMON.DERIV'
6355 ! include 'COMMON.LOCAL'
6356 ! include 'COMMON.INTERACT'
6357 ! include 'COMMON.CONTACTS'
6358 ! include 'COMMON.CHAIN'
6359 ! include 'COMMON.CONTROL'
6360 real(kind=8),dimension(3) :: gx,gx1
6361 integer,dimension(nres) :: num_cont_hb_old
6362 logical :: lprn,ldone
6363 !EL double precision eello4,eello5,eelo6,eello_turn6
6364 !EL external eello4,eello5,eello6,eello_turn6
6366 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
6367 j1,jp1,i1,num_conti1
6368 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
6369 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
6371 ! Set lprn=.true. for debugging
6376 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
6378 num_cont_hb_old(i)=num_cont_hb(i)
6382 if (nfgtasks.le.1) goto 30
6384 write (iout,'(a)') 'Contact function values before RECEIVE:'
6386 write (iout,'(2i3,50(1x,i2,f5.2))') &
6387 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6392 do i=1,ntask_cont_from
6395 do i=1,ntask_cont_to
6398 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6400 ! Make the list of contacts to send to send to other procesors
6401 do i=iturn3_start,iturn3_end
6402 ! write (iout,*) "make contact list turn3",i," num_cont",
6404 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6406 do i=iturn4_start,iturn4_end
6407 ! write (iout,*) "make contact list turn4",i," num_cont",
6409 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6413 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
6415 do j=1,num_cont_hb(i)
6418 iproc=iint_sent_local(k,jjc,ii)
6419 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6420 if (iproc.ne.0) then
6421 ncont_sent(iproc)=ncont_sent(iproc)+1
6422 nn=ncont_sent(iproc)
6424 zapas(2,nn,iproc)=jjc
6425 zapas(3,nn,iproc)=d_cont(j,i)
6429 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6434 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6442 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6453 "Numbers of contacts to be sent to other processors",&
6454 (ncont_sent(i),i=1,ntask_cont_to)
6455 write (iout,*) "Contacts sent"
6456 do ii=1,ntask_cont_to
6458 iproc=itask_cont_to(ii)
6459 write (iout,*) nn," contacts to processor",iproc,&
6460 " of CONT_TO_COMM group"
6462 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6470 CorrelID1=nfgtasks+fg_rank+1
6472 ! Receive the numbers of needed contacts from other processors
6473 do ii=1,ntask_cont_from
6474 iproc=itask_cont_from(ii)
6476 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
6477 FG_COMM,req(ireq),IERR)
6479 ! write (iout,*) "IRECV ended"
6481 ! Send the number of contacts needed by other processors
6482 do ii=1,ntask_cont_to
6483 iproc=itask_cont_to(ii)
6485 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
6486 FG_COMM,req(ireq),IERR)
6488 ! write (iout,*) "ISEND ended"
6489 ! write (iout,*) "number of requests (nn)",ireq
6492 call MPI_Waitall(ireq,req,status_array,ierr)
6494 ! & "Numbers of contacts to be received from other processors",
6495 ! & (ncont_recv(i),i=1,ntask_cont_from)
6499 do ii=1,ntask_cont_from
6500 iproc=itask_cont_from(ii)
6502 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
6503 ! & " of CONT_TO_COMM group"
6507 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
6508 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6509 ! write (iout,*) "ireq,req",ireq,req(ireq)
6512 ! Send the contacts to processors that need them
6513 do ii=1,ntask_cont_to
6514 iproc=itask_cont_to(ii)
6516 ! write (iout,*) nn," contacts to processor",iproc,
6517 ! & " of CONT_TO_COMM group"
6520 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
6521 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6522 ! write (iout,*) "ireq,req",ireq,req(ireq)
6524 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6528 ! write (iout,*) "number of requests (contacts)",ireq
6529 ! write (iout,*) "req",(req(i),i=1,4)
6532 call MPI_Waitall(ireq,req,status_array,ierr)
6533 do iii=1,ntask_cont_from
6534 iproc=itask_cont_from(iii)
6537 write (iout,*) "Received",nn," contacts from processor",iproc,&
6538 " of CONT_FROM_COMM group"
6541 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6546 ii=zapas_recv(1,i,iii)
6547 ! Flag the received contacts to prevent double-counting
6548 jj=-zapas_recv(2,i,iii)
6549 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6551 nnn=num_cont_hb(ii)+1
6554 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6558 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6563 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6571 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6580 write (iout,'(a)') 'Contact function values after receive:'
6582 write (iout,'(2i3,50(1x,i3,5f6.3))') &
6583 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
6584 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6591 write (iout,'(a)') 'Contact function values:'
6593 write (iout,'(2i3,50(1x,i2,5f6.3))') &
6594 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
6595 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6602 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6603 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6604 ! Remove the loop below after debugging !!!
6611 ! Calculate the dipole-dipole interaction energies
6612 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6613 do i=iatel_s,iatel_e+1
6614 num_conti=num_cont_hb(i)
6623 ! Calculate the local-electrostatic correlation terms
6624 ! write (iout,*) "gradcorr5 in eello5 before loop"
6626 ! write (iout,'(i5,3f10.5)')
6627 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6629 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6630 ! write (iout,*) "corr loop i",i
6632 num_conti=num_cont_hb(i)
6633 num_conti1=num_cont_hb(i+1)
6640 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6641 ! & ' jj=',jj,' kk=',kk
6642 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
6643 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
6644 .or. j.lt.0 .and. j1.gt.0) .and. &
6645 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6646 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6647 ! The system gains extra energy.
6649 sqd1=dsqrt(d_cont(jj,i))
6650 sqd2=dsqrt(d_cont(kk,i1))
6651 sred_geom = sqd1*sqd2
6652 IF (sred_geom.lt.cutoff_corr) THEN
6653 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
6655 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6656 !d & ' jj=',jj,' kk=',kk
6657 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6658 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6660 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6661 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6664 !d write (iout,*) 'sred_geom=',sred_geom,
6665 !d & ' ekont=',ekont,' fprim=',fprimcont,
6666 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6667 !d write (iout,*) "g_contij",g_contij
6668 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6669 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6670 call calc_eello(i,jp,i+1,jp1,jj,kk)
6671 if (wcorr4.gt.0.0d0) &
6672 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6673 if (energy_dec.and.wcorr4.gt.0.0d0) &
6674 write (iout,'(a6,4i5,0pf7.3)') &
6675 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6676 ! write (iout,*) "gradcorr5 before eello5"
6678 ! write (iout,'(i5,3f10.5)')
6679 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6681 if (wcorr5.gt.0.0d0) &
6682 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6683 ! write (iout,*) "gradcorr5 after eello5"
6685 ! write (iout,'(i5,3f10.5)')
6686 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6688 if (energy_dec.and.wcorr5.gt.0.0d0) &
6689 write (iout,'(a6,4i5,0pf7.3)') &
6690 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6691 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6692 !d write(2,*)'ijkl',i,jp,i+1,jp1
6693 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
6694 .or. wturn6.eq.0.0d0))then
6695 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6696 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6697 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
6698 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6699 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6700 !d & 'ecorr6=',ecorr6
6701 !d write (iout,'(4e15.5)') sred_geom,
6702 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6703 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6704 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6705 else if (wturn6.gt.0.0d0 &
6706 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6707 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6708 eturn6=eturn6+eello_turn6(i,jj,kk)
6709 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
6710 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6711 !d write (2,*) 'multibody_eello:eturn6',eturn6
6720 num_cont_hb(i)=num_cont_hb_old(i)
6722 ! write (iout,*) "gradcorr5 in eello5"
6724 ! write (iout,'(i5,3f10.5)')
6725 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6728 end subroutine multibody_eello
6729 !-----------------------------------------------------------------------------
6730 subroutine add_hb_contact_eello(ii,jj,itask)
6731 ! implicit real*8 (a-h,o-z)
6732 ! include "DIMENSIONS"
6733 ! include "COMMON.IOUNITS"
6734 ! include "COMMON.CONTACTS"
6735 ! integer,parameter :: maxconts=nres/4
6736 integer,parameter :: max_dim=70
6737 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
6738 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6739 ! common /przechowalnia/ zapas
6741 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
6742 integer,dimension(4) ::itask
6743 ! write (iout,*) "itask",itask
6746 if (iproc.gt.0) then
6747 do j=1,num_cont_hb(ii)
6749 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6751 ncont_sent(iproc)=ncont_sent(iproc)+1
6752 nn=ncont_sent(iproc)
6753 zapas(1,nn,iproc)=ii
6754 zapas(2,nn,iproc)=jjc
6755 zapas(3,nn,iproc)=d_cont(j,ii)
6759 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6764 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6772 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6783 end subroutine add_hb_contact_eello
6784 !-----------------------------------------------------------------------------
6785 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6786 ! implicit real*8 (a-h,o-z)
6787 ! include 'DIMENSIONS'
6788 ! include 'COMMON.IOUNITS'
6789 ! include 'COMMON.DERIV'
6790 ! include 'COMMON.INTERACT'
6791 ! include 'COMMON.CONTACTS'
6792 real(kind=8),dimension(3) :: gx,gx1
6795 integer :: i,j,k,l,jj,kk,ll
6796 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
6797 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
6798 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl
6808 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6809 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6810 ! Following 4 lines for diagnostics.
6815 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6816 ! & 'Contacts ',i,j,
6817 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6818 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6820 ! Calculate the multi-body contribution to energy.
6821 ! ecorr=ecorr+ekont*ees
6822 ! Calculate multi-body contributions to the gradient.
6823 coeffpees0pij=coeffp*ees0pij
6824 coeffmees0mij=coeffm*ees0mij
6825 coeffpees0pkl=coeffp*ees0pkl
6826 coeffmees0mkl=coeffm*ees0mkl
6828 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6829 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
6830 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
6831 coeffmees0mkl*gacontm_hb1(ll,jj,i))
6832 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
6833 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
6834 coeffmees0mkl*gacontm_hb2(ll,jj,i))
6835 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6836 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
6837 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
6838 coeffmees0mij*gacontm_hb1(ll,kk,k))
6839 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
6840 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
6841 coeffmees0mij*gacontm_hb2(ll,kk,k))
6842 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
6843 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
6844 coeffmees0mkl*gacontm_hb3(ll,jj,i))
6845 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6846 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6847 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
6848 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
6849 coeffmees0mij*gacontm_hb3(ll,kk,k))
6850 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6851 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6852 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6857 !grad gradcorr(ll,m)=gradcorr(ll,m)+
6858 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
6859 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6860 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6865 !grad gradcorr(ll,m)=gradcorr(ll,m)+
6866 !grad & ees*eij*gacont_hbr(ll,kk,k)-
6867 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6868 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6871 ! write (iout,*) "ehbcorr",ekont*ees
6874 end function ehbcorr
6876 !-----------------------------------------------------------------------------
6877 subroutine dipole(i,j,jj)
6878 ! implicit real*8 (a-h,o-z)
6879 ! include 'DIMENSIONS'
6880 ! include 'COMMON.IOUNITS'
6881 ! include 'COMMON.CHAIN'
6882 ! include 'COMMON.FFIELD'
6883 ! include 'COMMON.DERIV'
6884 ! include 'COMMON.INTERACT'
6885 ! include 'COMMON.CONTACTS'
6886 ! include 'COMMON.TORSION'
6887 ! include 'COMMON.VAR'
6888 ! include 'COMMON.GEO'
6889 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
6890 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
6891 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
6893 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
6894 allocate(dipderx(3,5,4,maxconts,nres))
6897 iti1 = itortyp(itype(i+1))
6898 if (j.lt.nres-1) then
6899 itj1 = itortyp(itype(j+1))
6904 dipi(iii,1)=Ub2(iii,i)
6905 dipderi(iii)=Ub2der(iii,i)
6906 dipi(iii,2)=b1(iii,iti1)
6907 dipj(iii,1)=Ub2(iii,j)
6908 dipderj(iii)=Ub2der(iii,j)
6909 dipj(iii,2)=b1(iii,itj1)
6913 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6916 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6923 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
6927 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6932 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6933 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6935 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6937 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6939 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6942 end subroutine dipole
6944 !-----------------------------------------------------------------------------
6945 subroutine calc_eello(i,j,k,l,jj,kk)
6947 ! This subroutine computes matrices and vectors needed to calculate
6948 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
6951 ! implicit real*8 (a-h,o-z)
6952 ! include 'DIMENSIONS'
6953 ! include 'COMMON.IOUNITS'
6954 ! include 'COMMON.CHAIN'
6955 ! include 'COMMON.DERIV'
6956 ! include 'COMMON.INTERACT'
6957 ! include 'COMMON.CONTACTS'
6958 ! include 'COMMON.TORSION'
6959 ! include 'COMMON.VAR'
6960 ! include 'COMMON.GEO'
6961 ! include 'COMMON.FFIELD'
6962 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
6963 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
6964 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
6967 !el common /kutas/ lprn
6968 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6969 !d & ' jj=',jj,' kk=',kk
6970 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6971 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6972 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6975 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6976 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6979 call transpose2(aa1(1,1),aa1t(1,1))
6980 call transpose2(aa2(1,1),aa2t(1,1))
6983 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
6984 aa1tder(1,1,lll,kkk))
6985 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
6986 aa2tder(1,1,lll,kkk))
6990 ! parallel orientation of the two CA-CA-CA frames.
6992 iti=itortyp(itype(i))
6996 itk1=itortyp(itype(k+1))
6997 itj=itortyp(itype(j))
6998 if (l.lt.nres-1) then
6999 itl1=itortyp(itype(l+1))
7003 ! A1 kernel(j+1) A2T
7005 !d write (iout,'(3f10.5,5x,3f10.5)')
7006 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7008 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7009 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
7010 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7011 ! Following matrices are needed only for 6-th order cumulants
7012 IF (wcorr6.gt.0.0d0) THEN
7013 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7014 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
7015 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7016 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7017 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
7018 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
7019 ADtEAderx(1,1,1,1,1,1))
7021 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7022 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
7023 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
7024 ADtEA1derx(1,1,1,1,1,1))
7026 ! End 6-th order cumulants
7029 !d write (2,*) 'In calc_eello6'
7031 !d write (2,*) 'iii=',iii
7033 !d write (2,*) 'kkk=',kkk
7035 !d write (2,'(3(2f10.5),5x)')
7036 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7041 call transpose2(EUgder(1,1,k),auxmat(1,1))
7042 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7043 call transpose2(EUg(1,1,k),auxmat(1,1))
7044 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7045 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7049 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7050 EAEAderx(1,1,lll,kkk,iii,1))
7054 ! A1T kernel(i+1) A2
7055 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7056 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
7057 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7058 ! Following matrices are needed only for 6-th order cumulants
7059 IF (wcorr6.gt.0.0d0) THEN
7060 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7061 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
7062 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7063 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7064 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
7065 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
7066 ADtEAderx(1,1,1,1,1,2))
7067 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7068 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
7069 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
7070 ADtEA1derx(1,1,1,1,1,2))
7072 ! End 6-th order cumulants
7073 call transpose2(EUgder(1,1,l),auxmat(1,1))
7074 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7075 call transpose2(EUg(1,1,l),auxmat(1,1))
7076 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7077 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7081 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7082 EAEAderx(1,1,lll,kkk,iii,2))
7087 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7088 ! They are needed only when the fifth- or the sixth-order cumulants are
7090 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7091 call transpose2(AEA(1,1,1),auxmat(1,1))
7092 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7093 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7094 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7095 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7096 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7097 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7098 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7099 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7100 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7101 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7102 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7103 call transpose2(AEA(1,1,2),auxmat(1,1))
7104 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7105 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7106 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7107 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7108 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7109 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7110 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7111 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7112 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7113 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7114 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7115 ! Calculate the Cartesian derivatives of the vectors.
7119 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7120 call matvec2(auxmat(1,1),b1(1,iti),&
7121 AEAb1derx(1,lll,kkk,iii,1,1))
7122 call matvec2(auxmat(1,1),Ub2(1,i),&
7123 AEAb2derx(1,lll,kkk,iii,1,1))
7124 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
7125 AEAb1derx(1,lll,kkk,iii,2,1))
7126 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
7127 AEAb2derx(1,lll,kkk,iii,2,1))
7128 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7129 call matvec2(auxmat(1,1),b1(1,itj),&
7130 AEAb1derx(1,lll,kkk,iii,1,2))
7131 call matvec2(auxmat(1,1),Ub2(1,j),&
7132 AEAb2derx(1,lll,kkk,iii,1,2))
7133 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
7134 AEAb1derx(1,lll,kkk,iii,2,2))
7135 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
7136 AEAb2derx(1,lll,kkk,iii,2,2))
7143 ! Antiparallel orientation of the two CA-CA-CA frames.
7145 iti=itortyp(itype(i))
7149 itk1=itortyp(itype(k+1))
7150 itl=itortyp(itype(l))
7151 itj=itortyp(itype(j))
7152 if (j.lt.nres-1) then
7153 itj1=itortyp(itype(j+1))
7157 ! A2 kernel(j-1)T A1T
7158 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7159 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
7160 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7161 ! Following matrices are needed only for 6-th order cumulants
7162 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
7163 j.eq.i+4 .and. l.eq.i+3)) THEN
7164 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7165 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
7166 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7167 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7168 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
7169 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
7170 ADtEAderx(1,1,1,1,1,1))
7171 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7172 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
7173 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
7174 ADtEA1derx(1,1,1,1,1,1))
7176 ! End 6-th order cumulants
7177 call transpose2(EUgder(1,1,k),auxmat(1,1))
7178 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7179 call transpose2(EUg(1,1,k),auxmat(1,1))
7180 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7181 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7185 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7186 EAEAderx(1,1,lll,kkk,iii,1))
7190 ! A2T kernel(i+1)T A1
7191 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7192 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
7193 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7194 ! Following matrices are needed only for 6-th order cumulants
7195 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
7196 j.eq.i+4 .and. l.eq.i+3)) THEN
7197 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7198 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
7199 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7200 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7201 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
7202 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
7203 ADtEAderx(1,1,1,1,1,2))
7204 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7205 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
7206 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
7207 ADtEA1derx(1,1,1,1,1,2))
7209 ! End 6-th order cumulants
7210 call transpose2(EUgder(1,1,j),auxmat(1,1))
7211 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7212 call transpose2(EUg(1,1,j),auxmat(1,1))
7213 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7214 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7218 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7219 EAEAderx(1,1,lll,kkk,iii,2))
7224 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7225 ! They are needed only when the fifth- or the sixth-order cumulants are
7227 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
7228 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7229 call transpose2(AEA(1,1,1),auxmat(1,1))
7230 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7231 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7232 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7233 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7234 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7235 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7236 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7237 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7238 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7239 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7240 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7241 call transpose2(AEA(1,1,2),auxmat(1,1))
7242 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7243 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7244 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7245 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7246 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7247 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7248 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7249 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7250 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7251 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7252 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7253 ! Calculate the Cartesian derivatives of the vectors.
7257 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7258 call matvec2(auxmat(1,1),b1(1,iti),&
7259 AEAb1derx(1,lll,kkk,iii,1,1))
7260 call matvec2(auxmat(1,1),Ub2(1,i),&
7261 AEAb2derx(1,lll,kkk,iii,1,1))
7262 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
7263 AEAb1derx(1,lll,kkk,iii,2,1))
7264 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
7265 AEAb2derx(1,lll,kkk,iii,2,1))
7266 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7267 call matvec2(auxmat(1,1),b1(1,itl),&
7268 AEAb1derx(1,lll,kkk,iii,1,2))
7269 call matvec2(auxmat(1,1),Ub2(1,l),&
7270 AEAb2derx(1,lll,kkk,iii,1,2))
7271 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
7272 AEAb1derx(1,lll,kkk,iii,2,2))
7273 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
7274 AEAb2derx(1,lll,kkk,iii,2,2))
7282 end subroutine calc_eello
7283 !-----------------------------------------------------------------------------
7284 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
7289 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
7290 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
7291 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
7292 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
7293 integer :: iii,kkk,lll
7296 !el common /kutas/ lprn
7297 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7299 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
7302 !d if (lprn) write (2,*) 'In kernel'
7304 !d if (lprn) write (2,*) 'kkk=',kkk
7306 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
7307 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7309 !d write (2,*) 'lll=',lll
7310 !d write (2,*) 'iii=1'
7312 !d write (2,'(3(2f10.5),5x)')
7313 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7316 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
7317 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7319 !d write (2,*) 'lll=',lll
7320 !d write (2,*) 'iii=2'
7322 !d write (2,'(3(2f10.5),5x)')
7323 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7329 end subroutine kernel
7330 !-----------------------------------------------------------------------------
7331 real(kind=8) function eello4(i,j,k,l,jj,kk)
7332 ! implicit real*8 (a-h,o-z)
7333 ! include 'DIMENSIONS'
7334 ! include 'COMMON.IOUNITS'
7335 ! include 'COMMON.CHAIN'
7336 ! include 'COMMON.DERIV'
7337 ! include 'COMMON.INTERACT'
7338 ! include 'COMMON.CONTACTS'
7339 ! include 'COMMON.TORSION'
7340 ! include 'COMMON.VAR'
7341 ! include 'COMMON.GEO'
7342 real(kind=8),dimension(2,2) :: pizda
7343 real(kind=8),dimension(3) :: ggg1,ggg2
7344 real(kind=8) :: eel4,glongij,glongkl
7345 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
7346 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7350 !d print *,'eello4:',i,j,k,l,jj,kk
7351 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
7352 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
7353 !old eij=facont_hb(jj,i)
7354 !old ekl=facont_hb(kk,k)
7356 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7357 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7358 gcorr_loc(k-1)=gcorr_loc(k-1) &
7359 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7361 gcorr_loc(l-1)=gcorr_loc(l-1) &
7362 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7364 gcorr_loc(j-1)=gcorr_loc(j-1) &
7365 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7370 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
7371 -EAEAderx(2,2,lll,kkk,iii,1)
7372 !d derx(lll,kkk,iii)=0.0d0
7376 !d gcorr_loc(l-1)=0.0d0
7377 !d gcorr_loc(j-1)=0.0d0
7378 !d gcorr_loc(k-1)=0.0d0
7380 !d write (iout,*)'Contacts have occurred for peptide groups',
7381 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
7382 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7383 if (j.lt.nres-1) then
7390 if (l.lt.nres-1) then
7398 !grad ggg1(ll)=eel4*g_contij(ll,1)
7399 !grad ggg2(ll)=eel4*g_contij(ll,2)
7400 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7401 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7402 !grad ghalf=0.5d0*ggg1(ll)
7403 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7404 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7405 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7406 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7407 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7408 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7409 !grad ghalf=0.5d0*ggg2(ll)
7410 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7411 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7412 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7413 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7414 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7415 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7419 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7424 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7429 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7434 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7438 !d write (2,*) iii,gcorr_loc(iii)
7441 !d write (2,*) 'ekont',ekont
7442 !d write (iout,*) 'eello4',ekont*eel4
7445 !-----------------------------------------------------------------------------
7446 real(kind=8) function eello5(i,j,k,l,jj,kk)
7447 ! implicit real*8 (a-h,o-z)
7448 ! include 'DIMENSIONS'
7449 ! include 'COMMON.IOUNITS'
7450 ! include 'COMMON.CHAIN'
7451 ! include 'COMMON.DERIV'
7452 ! include 'COMMON.INTERACT'
7453 ! include 'COMMON.CONTACTS'
7454 ! include 'COMMON.TORSION'
7455 ! include 'COMMON.VAR'
7456 ! include 'COMMON.GEO'
7457 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
7458 real(kind=8),dimension(2) :: vv
7459 real(kind=8),dimension(3) :: ggg1,ggg2
7460 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
7461 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
7462 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
7463 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7468 ! /l\ / \ \ / \ / \ / C
7469 ! / \ / \ \ / \ / \ / C
7470 ! j| o |l1 | o | o| o | | o |o C
7471 ! \ |/k\| |/ \| / |/ \| |/ \| C
7472 ! \i/ \ / \ / / \ / \ C
7474 ! (I) (II) (III) (IV) C
7476 ! eello5_1 eello5_2 eello5_3 eello5_4 C
7478 ! Antiparallel chains C
7481 ! /j\ / \ \ / \ / \ / C
7482 ! / \ / \ \ / \ / \ / C
7483 ! j1| o |l | o | o| o | | o |o C
7484 ! \ |/k\| |/ \| / |/ \| |/ \| C
7485 ! \i/ \ / \ / / \ / \ C
7487 ! (I) (II) (III) (IV) C
7489 ! eello5_1 eello5_2 eello5_3 eello5_4 C
7491 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
7493 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7494 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7499 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7501 itk=itortyp(itype(k))
7502 itl=itortyp(itype(l))
7503 itj=itortyp(itype(j))
7508 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7509 !d & eel5_3_num,eel5_4_num)
7513 derx(lll,kkk,iii)=0.0d0
7517 !d eij=facont_hb(jj,i)
7518 !d ekl=facont_hb(kk,k)
7520 !d write (iout,*)'Contacts have occurred for peptide groups',
7521 !d & i,j,' fcont:',eij,' eij',' and ',k,l
7523 ! Contribution from the graph I.
7524 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7525 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7526 call transpose2(EUg(1,1,k),auxmat(1,1))
7527 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7528 vv(1)=pizda(1,1)-pizda(2,2)
7529 vv(2)=pizda(1,2)+pizda(2,1)
7530 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
7531 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7532 ! Explicit gradient in virtual-dihedral angles.
7533 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
7534 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
7535 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7536 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7537 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7538 vv(1)=pizda(1,1)-pizda(2,2)
7539 vv(2)=pizda(1,2)+pizda(2,1)
7540 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7541 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
7542 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7543 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7544 vv(1)=pizda(1,1)-pizda(2,2)
7545 vv(2)=pizda(1,2)+pizda(2,1)
7547 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7548 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
7549 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7551 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7552 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
7553 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7555 ! Cartesian gradient
7559 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
7561 vv(1)=pizda(1,1)-pizda(2,2)
7562 vv(2)=pizda(1,2)+pizda(2,1)
7563 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7564 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
7565 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7571 ! Contribution from graph II
7572 call transpose2(EE(1,1,itk),auxmat(1,1))
7573 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7574 vv(1)=pizda(1,1)+pizda(2,2)
7575 vv(2)=pizda(2,1)-pizda(1,2)
7576 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
7577 -0.5d0*scalar2(vv(1),Ctobr(1,k))
7578 ! Explicit gradient in virtual-dihedral angles.
7579 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7580 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7581 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7582 vv(1)=pizda(1,1)+pizda(2,2)
7583 vv(2)=pizda(2,1)-pizda(1,2)
7585 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7586 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
7587 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7589 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7590 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
7591 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7593 ! Cartesian gradient
7597 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7599 vv(1)=pizda(1,1)+pizda(2,2)
7600 vv(2)=pizda(2,1)-pizda(1,2)
7601 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7602 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
7603 -0.5d0*scalar2(vv(1),Ctobr(1,k))
7611 ! Parallel orientation
7612 ! Contribution from graph III
7613 call transpose2(EUg(1,1,l),auxmat(1,1))
7614 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7615 vv(1)=pizda(1,1)-pizda(2,2)
7616 vv(2)=pizda(1,2)+pizda(2,1)
7617 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
7618 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7619 ! Explicit gradient in virtual-dihedral angles.
7620 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7621 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
7622 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7623 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7624 vv(1)=pizda(1,1)-pizda(2,2)
7625 vv(2)=pizda(1,2)+pizda(2,1)
7626 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7627 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
7628 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7629 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7630 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7631 vv(1)=pizda(1,1)-pizda(2,2)
7632 vv(2)=pizda(1,2)+pizda(2,1)
7633 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7634 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
7635 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7636 ! Cartesian gradient
7640 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
7642 vv(1)=pizda(1,1)-pizda(2,2)
7643 vv(2)=pizda(1,2)+pizda(2,1)
7644 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7645 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
7646 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7651 ! Contribution from graph IV
7653 call transpose2(EE(1,1,itl),auxmat(1,1))
7654 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7655 vv(1)=pizda(1,1)+pizda(2,2)
7656 vv(2)=pizda(2,1)-pizda(1,2)
7657 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
7658 -0.5d0*scalar2(vv(1),Ctobr(1,l))
7659 ! Explicit gradient in virtual-dihedral angles.
7660 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7661 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7662 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7663 vv(1)=pizda(1,1)+pizda(2,2)
7664 vv(2)=pizda(2,1)-pizda(1,2)
7665 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7666 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
7667 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7668 ! Cartesian gradient
7672 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7674 vv(1)=pizda(1,1)+pizda(2,2)
7675 vv(2)=pizda(2,1)-pizda(1,2)
7676 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7677 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
7678 -0.5d0*scalar2(vv(1),Ctobr(1,l))
7683 ! Antiparallel orientation
7684 ! Contribution from graph III
7686 call transpose2(EUg(1,1,j),auxmat(1,1))
7687 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7688 vv(1)=pizda(1,1)-pizda(2,2)
7689 vv(2)=pizda(1,2)+pizda(2,1)
7690 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
7691 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7692 ! Explicit gradient in virtual-dihedral angles.
7693 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7694 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
7695 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7696 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7697 vv(1)=pizda(1,1)-pizda(2,2)
7698 vv(2)=pizda(1,2)+pizda(2,1)
7699 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7700 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
7701 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7702 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7703 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7704 vv(1)=pizda(1,1)-pizda(2,2)
7705 vv(2)=pizda(1,2)+pizda(2,1)
7706 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7707 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
7708 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7709 ! Cartesian gradient
7713 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
7715 vv(1)=pizda(1,1)-pizda(2,2)
7716 vv(2)=pizda(1,2)+pizda(2,1)
7717 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
7718 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
7719 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7724 ! Contribution from graph IV
7726 call transpose2(EE(1,1,itj),auxmat(1,1))
7727 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7728 vv(1)=pizda(1,1)+pizda(2,2)
7729 vv(2)=pizda(2,1)-pizda(1,2)
7730 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
7731 -0.5d0*scalar2(vv(1),Ctobr(1,j))
7732 ! Explicit gradient in virtual-dihedral angles.
7733 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7734 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7735 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7736 vv(1)=pizda(1,1)+pizda(2,2)
7737 vv(2)=pizda(2,1)-pizda(1,2)
7738 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7739 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
7740 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7741 ! Cartesian gradient
7745 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7747 vv(1)=pizda(1,1)+pizda(2,2)
7748 vv(2)=pizda(2,1)-pizda(1,2)
7749 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
7750 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
7751 -0.5d0*scalar2(vv(1),Ctobr(1,j))
7757 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7758 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7759 !d write (2,*) 'ijkl',i,j,k,l
7760 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7761 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
7763 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7764 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7765 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7766 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7767 if (j.lt.nres-1) then
7774 if (l.lt.nres-1) then
7784 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7785 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
7786 ! summed up outside the subrouine as for the other subroutines
7787 ! handling long-range interactions. The old code is commented out
7788 ! with "cgrad" to keep track of changes.
7790 !grad ggg1(ll)=eel5*g_contij(ll,1)
7791 !grad ggg2(ll)=eel5*g_contij(ll,2)
7792 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7793 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7794 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7795 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7796 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7797 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7798 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7799 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7801 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7802 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7803 !grad ghalf=0.5d0*ggg1(ll)
7805 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7806 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7807 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7808 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7809 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7810 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7811 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7812 !grad ghalf=0.5d0*ggg2(ll)
7814 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7815 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7816 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7817 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7818 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7819 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7824 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7825 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7830 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7831 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7837 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7842 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7846 !d write (2,*) iii,g_corr5_loc(iii)
7849 !d write (2,*) 'ekont',ekont
7850 !d write (iout,*) 'eello5',ekont*eel5
7853 !-----------------------------------------------------------------------------
7854 real(kind=8) function eello6(i,j,k,l,jj,kk)
7855 ! implicit real*8 (a-h,o-z)
7856 ! include 'DIMENSIONS'
7857 ! include 'COMMON.IOUNITS'
7858 ! include 'COMMON.CHAIN'
7859 ! include 'COMMON.DERIV'
7860 ! include 'COMMON.INTERACT'
7861 ! include 'COMMON.CONTACTS'
7862 ! include 'COMMON.TORSION'
7863 ! include 'COMMON.VAR'
7864 ! include 'COMMON.GEO'
7865 ! include 'COMMON.FFIELD'
7866 real(kind=8),dimension(3) :: ggg1,ggg2
7867 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
7869 real(kind=8) :: gradcorr6ij,gradcorr6kl
7870 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
7871 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7876 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7884 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7885 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7889 derx(lll,kkk,iii)=0.0d0
7893 !d eij=facont_hb(jj,i)
7894 !d ekl=facont_hb(kk,k)
7900 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7901 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7902 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7903 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7904 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7905 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7907 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7908 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7909 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7910 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7911 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7912 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7916 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7918 ! If turn contributions are considered, they will be handled separately.
7919 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7920 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7921 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7922 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7923 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7924 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7925 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7927 if (j.lt.nres-1) then
7934 if (l.lt.nres-1) then
7942 !grad ggg1(ll)=eel6*g_contij(ll,1)
7943 !grad ggg2(ll)=eel6*g_contij(ll,2)
7944 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7945 !grad ghalf=0.5d0*ggg1(ll)
7947 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7948 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7949 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7950 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7951 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7952 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7953 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7954 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7955 !grad ghalf=0.5d0*ggg2(ll)
7956 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7958 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7959 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7960 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7961 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7962 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7963 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7968 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7969 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7974 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7975 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7981 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7986 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7990 !d write (2,*) iii,g_corr6_loc(iii)
7993 !d write (2,*) 'ekont',ekont
7994 !d write (iout,*) 'eello6',ekont*eel6
7997 !-----------------------------------------------------------------------------
7998 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
8000 ! implicit real*8 (a-h,o-z)
8001 ! include 'DIMENSIONS'
8002 ! include 'COMMON.IOUNITS'
8003 ! include 'COMMON.CHAIN'
8004 ! include 'COMMON.DERIV'
8005 ! include 'COMMON.INTERACT'
8006 ! include 'COMMON.CONTACTS'
8007 ! include 'COMMON.TORSION'
8008 ! include 'COMMON.VAR'
8009 ! include 'COMMON.GEO'
8010 real(kind=8),dimension(2) :: vv,vv1
8011 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
8014 !el common /kutas/ lprn
8015 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
8016 real(kind=8) :: s1,s2,s3,s4,s5
8017 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8019 ! Parallel Antiparallel C
8025 ! \ j|/k\| / \ |/k\|l / C
8030 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8031 itk=itortyp(itype(k))
8032 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8033 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8034 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8035 call transpose2(EUgC(1,1,k),auxmat(1,1))
8036 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8037 vv1(1)=pizda1(1,1)-pizda1(2,2)
8038 vv1(2)=pizda1(1,2)+pizda1(2,1)
8039 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8040 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8041 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8042 s5=scalar2(vv(1),Dtobr2(1,i))
8043 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8044 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8045 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
8046 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
8047 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
8048 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
8049 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
8050 +scalar2(vv(1),Dtobr2der(1,i)))
8051 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8052 vv1(1)=pizda1(1,1)-pizda1(2,2)
8053 vv1(2)=pizda1(1,2)+pizda1(2,1)
8054 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8055 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8057 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
8058 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
8059 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
8060 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
8061 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8063 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
8064 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
8065 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
8066 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
8067 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8069 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8070 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8071 vv1(1)=pizda1(1,1)-pizda1(2,2)
8072 vv1(2)=pizda1(1,2)+pizda1(2,1)
8073 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
8074 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
8075 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
8076 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8085 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8086 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8087 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8088 call transpose2(EUgC(1,1,k),auxmat(1,1))
8089 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
8091 vv1(1)=pizda1(1,1)-pizda1(2,2)
8092 vv1(2)=pizda1(1,2)+pizda1(2,1)
8093 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8094 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
8095 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8096 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
8097 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8098 s5=scalar2(vv(1),Dtobr2(1,i))
8099 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8104 end function eello6_graph1
8105 !-----------------------------------------------------------------------------
8106 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
8108 ! implicit real*8 (a-h,o-z)
8109 ! include 'DIMENSIONS'
8110 ! include 'COMMON.IOUNITS'
8111 ! include 'COMMON.CHAIN'
8112 ! include 'COMMON.DERIV'
8113 ! include 'COMMON.INTERACT'
8114 ! include 'COMMON.CONTACTS'
8115 ! include 'COMMON.TORSION'
8116 ! include 'COMMON.VAR'
8117 ! include 'COMMON.GEO'
8119 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
8120 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8122 !el common /kutas/ lprn
8123 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
8124 real(kind=8) :: s2,s3,s4
8125 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8127 ! Parallel Antiparallel C
8133 ! \ j|/k\| \ |/k\|l C
8138 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8139 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8140 ! AL 7/4/01 s1 would occur in the sixth-order moment,
8141 ! but not in a cluster cumulant
8143 s1=dip(1,jj,i)*dip(1,kk,k)
8145 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8146 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8147 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8148 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8149 call transpose2(EUg(1,1,k),auxmat(1,1))
8150 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8151 vv(1)=pizda(1,1)-pizda(2,2)
8152 vv(2)=pizda(1,2)+pizda(2,1)
8153 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8154 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8156 eello6_graph2=-(s1+s2+s3+s4)
8158 eello6_graph2=-(s2+s3+s4)
8161 ! Derivatives in gamma(i-1)
8164 s1=dipderg(1,jj,i)*dip(1,kk,k)
8166 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8167 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8168 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8169 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8171 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8173 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8175 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8177 ! Derivatives in gamma(k-1)
8179 s1=dip(1,jj,i)*dipderg(1,kk,k)
8181 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8182 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8183 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8184 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8185 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8186 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8187 vv(1)=pizda(1,1)-pizda(2,2)
8188 vv(2)=pizda(1,2)+pizda(2,1)
8189 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8191 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8193 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8195 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8196 ! Derivatives in gamma(j-1) or gamma(l-1)
8199 s1=dipderg(3,jj,i)*dip(1,kk,k)
8201 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8202 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8203 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8204 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8205 vv(1)=pizda(1,1)-pizda(2,2)
8206 vv(2)=pizda(1,2)+pizda(2,1)
8207 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8210 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8212 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8215 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8216 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8218 ! Derivatives in gamma(l-1) or gamma(j-1)
8221 s1=dip(1,jj,i)*dipderg(3,kk,k)
8223 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8224 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8225 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8226 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8227 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8228 vv(1)=pizda(1,1)-pizda(2,2)
8229 vv(2)=pizda(1,2)+pizda(2,1)
8230 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8233 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8235 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8238 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8239 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8241 ! Cartesian derivatives.
8243 write (2,*) 'In eello6_graph2'
8245 write (2,*) 'iii=',iii
8247 write (2,*) 'kkk=',kkk
8249 write (2,'(3(2f10.5),5x)') &
8250 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8260 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8262 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8265 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
8267 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8268 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
8270 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8271 call transpose2(EUg(1,1,k),auxmat(1,1))
8272 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8274 vv(1)=pizda(1,1)-pizda(2,2)
8275 vv(2)=pizda(1,2)+pizda(2,1)
8276 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8277 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8279 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8281 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8284 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8286 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8292 end function eello6_graph2
8293 !-----------------------------------------------------------------------------
8294 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
8295 ! implicit real*8 (a-h,o-z)
8296 ! include 'DIMENSIONS'
8297 ! include 'COMMON.IOUNITS'
8298 ! include 'COMMON.CHAIN'
8299 ! include 'COMMON.DERIV'
8300 ! include 'COMMON.INTERACT'
8301 ! include 'COMMON.CONTACTS'
8302 ! include 'COMMON.TORSION'
8303 ! include 'COMMON.VAR'
8304 ! include 'COMMON.GEO'
8305 real(kind=8),dimension(2) :: vv,auxvec
8306 real(kind=8),dimension(2,2) :: pizda,auxmat
8308 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
8309 real(kind=8) :: s1,s2,s3,s4
8310 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8312 ! Parallel Antiparallel C
8318 ! j|/k\| / |/k\|l / C
8323 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8325 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
8326 ! energy moment and not to the cluster cumulant.
8327 iti=itortyp(itype(i))
8328 if (j.lt.nres-1) then
8329 itj1=itortyp(itype(j+1))
8333 itk=itortyp(itype(k))
8334 itk1=itortyp(itype(k+1))
8335 if (l.lt.nres-1) then
8336 itl1=itortyp(itype(l+1))
8341 s1=dip(4,jj,i)*dip(4,kk,k)
8343 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8344 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8345 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8346 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8347 call transpose2(EE(1,1,itk),auxmat(1,1))
8348 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8349 vv(1)=pizda(1,1)+pizda(2,2)
8350 vv(2)=pizda(2,1)-pizda(1,2)
8351 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8352 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8353 !d & "sum",-(s2+s3+s4)
8355 eello6_graph3=-(s1+s2+s3+s4)
8357 eello6_graph3=-(s2+s3+s4)
8360 ! Derivatives in gamma(k-1)
8361 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8362 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8363 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8364 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8365 ! Derivatives in gamma(l-1)
8366 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8367 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8368 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8369 vv(1)=pizda(1,1)+pizda(2,2)
8370 vv(2)=pizda(2,1)-pizda(1,2)
8371 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8372 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8373 ! Cartesian derivatives.
8379 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8381 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8384 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8386 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8387 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8389 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8390 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
8392 vv(1)=pizda(1,1)+pizda(2,2)
8393 vv(2)=pizda(2,1)-pizda(1,2)
8394 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8396 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8398 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8401 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8403 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8405 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8410 end function eello6_graph3
8411 !-----------------------------------------------------------------------------
8412 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8413 ! implicit real*8 (a-h,o-z)
8414 ! include 'DIMENSIONS'
8415 ! include 'COMMON.IOUNITS'
8416 ! include 'COMMON.CHAIN'
8417 ! include 'COMMON.DERIV'
8418 ! include 'COMMON.INTERACT'
8419 ! include 'COMMON.CONTACTS'
8420 ! include 'COMMON.TORSION'
8421 ! include 'COMMON.VAR'
8422 ! include 'COMMON.GEO'
8423 ! include 'COMMON.FFIELD'
8424 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
8425 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8427 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
8429 real(kind=8) :: s1,s2,s3,s4
8430 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8432 ! Parallel Antiparallel C
8438 ! \ j|/k\| \ |/k\|l C
8443 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8445 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
8446 ! energy moment and not to the cluster cumulant.
8447 !d write (2,*) 'eello_graph4: wturn6',wturn6
8448 iti=itortyp(itype(i))
8449 itj=itortyp(itype(j))
8450 if (j.lt.nres-1) then
8451 itj1=itortyp(itype(j+1))
8455 itk=itortyp(itype(k))
8456 if (k.lt.nres-1) then
8457 itk1=itortyp(itype(k+1))
8461 itl=itortyp(itype(l))
8462 if (l.lt.nres-1) then
8463 itl1=itortyp(itype(l+1))
8467 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8468 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8469 !d & ' itl',itl,' itl1',itl1
8472 s1=dip(3,jj,i)*dip(3,kk,k)
8474 s1=dip(2,jj,j)*dip(2,kk,l)
8477 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8478 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8480 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8481 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8483 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8484 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8486 call transpose2(EUg(1,1,k),auxmat(1,1))
8487 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8488 vv(1)=pizda(1,1)-pizda(2,2)
8489 vv(2)=pizda(2,1)+pizda(1,2)
8490 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8491 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8493 eello6_graph4=-(s1+s2+s3+s4)
8495 eello6_graph4=-(s2+s3+s4)
8497 ! Derivatives in gamma(i-1)
8501 s1=dipderg(2,jj,i)*dip(3,kk,k)
8503 s1=dipderg(4,jj,j)*dip(2,kk,l)
8506 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8508 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8509 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8511 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8512 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8514 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8515 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8516 !d write (2,*) 'turn6 derivatives'
8518 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8520 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8524 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8526 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8530 ! Derivatives in gamma(k-1)
8533 s1=dip(3,jj,i)*dipderg(2,kk,k)
8535 s1=dip(2,jj,j)*dipderg(4,kk,l)
8538 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8539 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8541 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8542 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8544 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8545 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8547 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8548 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(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))
8552 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8554 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8556 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8560 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8562 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8565 ! Derivatives in gamma(j-1) or gamma(l-1)
8566 if (l.eq.j+1 .and. l.gt.1) then
8567 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8568 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8569 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8570 vv(1)=pizda(1,1)-pizda(2,2)
8571 vv(2)=pizda(2,1)+pizda(1,2)
8572 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8573 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8574 else if (j.gt.1) then
8575 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8576 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8577 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8578 vv(1)=pizda(1,1)-pizda(2,2)
8579 vv(2)=pizda(2,1)+pizda(1,2)
8580 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8581 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8582 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8584 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8587 ! Cartesian derivatives.
8594 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8596 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8600 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8602 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8606 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
8608 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8610 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
8611 b1(1,itj1),auxvec(1))
8612 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8614 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
8615 b1(1,itl1),auxvec(1))
8616 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8618 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
8620 vv(1)=pizda(1,1)-pizda(2,2)
8621 vv(2)=pizda(2,1)+pizda(1,2)
8622 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8624 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8626 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
8629 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
8632 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8635 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8637 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8639 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8643 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8645 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8648 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8650 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8657 end function eello6_graph4
8658 !-----------------------------------------------------------------------------
8659 real(kind=8) function eello_turn6(i,jj,kk)
8660 ! implicit real*8 (a-h,o-z)
8661 ! include 'DIMENSIONS'
8662 ! include 'COMMON.IOUNITS'
8663 ! include 'COMMON.CHAIN'
8664 ! include 'COMMON.DERIV'
8665 ! include 'COMMON.INTERACT'
8666 ! include 'COMMON.CONTACTS'
8667 ! include 'COMMON.TORSION'
8668 ! include 'COMMON.VAR'
8669 ! include 'COMMON.GEO'
8670 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
8671 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
8672 real(kind=8),dimension(3) :: ggg1,ggg2
8673 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
8674 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
8675 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8676 ! the respective energy moment and not to the cluster cumulant.
8678 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
8679 integer :: j1,j2,l1,l2,ll
8680 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
8681 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
8690 iti=itortyp(itype(i))
8691 itk=itortyp(itype(k))
8692 itk1=itortyp(itype(k+1))
8693 itl=itortyp(itype(l))
8694 itj=itortyp(itype(j))
8695 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8696 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
8697 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8702 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8704 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
8708 derx_turn(lll,kkk,iii)=0.0d0
8715 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8717 !d write (2,*) 'eello6_5',eello6_5
8719 call transpose2(AEA(1,1,1),auxmat(1,1))
8720 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8721 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8722 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8724 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8725 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8726 s2 = scalar2(b1(1,itk),vtemp1(1))
8728 call transpose2(AEA(1,1,2),atemp(1,1))
8729 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8730 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8731 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8733 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8734 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8735 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8737 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8738 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8739 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8740 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8741 ss13 = scalar2(b1(1,itk),vtemp4(1))
8742 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8744 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8750 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8751 ! Derivatives in gamma(i+2)
8755 call transpose2(AEA(1,1,1),auxmatd(1,1))
8756 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8757 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8758 call transpose2(AEAderg(1,1,2),atempd(1,1))
8759 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8760 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8762 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8763 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8764 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8770 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8771 ! Derivatives in gamma(i+3)
8773 call transpose2(AEA(1,1,1),auxmatd(1,1))
8774 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8775 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8776 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8778 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8779 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8780 s2d = scalar2(b1(1,itk),vtemp1d(1))
8782 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8783 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8785 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8787 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8788 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8789 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8797 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
8798 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8800 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
8801 -0.5d0*ekont*(s2d+s12d)
8803 ! Derivatives in gamma(i+4)
8804 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8805 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8806 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8808 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8809 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8810 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8818 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8820 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8822 ! Derivatives in gamma(i+5)
8824 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8825 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8826 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8828 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8829 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8830 s2d = scalar2(b1(1,itk),vtemp1d(1))
8832 call transpose2(AEA(1,1,2),atempd(1,1))
8833 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8834 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8836 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8837 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8839 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8840 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8841 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8849 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
8850 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8852 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
8853 -0.5d0*ekont*(s2d+s12d)
8855 ! Cartesian derivatives
8860 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8861 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8862 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8864 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8865 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
8867 s2d = scalar2(b1(1,itk),vtemp1d(1))
8869 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8870 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8871 s8d = -(atempd(1,1)+atempd(2,2))* &
8872 scalar2(cc(1,1,itl),vtemp2(1))
8874 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
8876 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8877 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8884 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
8887 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
8891 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
8894 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
8903 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
8905 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8906 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8907 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8908 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8909 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
8911 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8912 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8913 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8917 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8918 !d & 16*eel_turn6_num
8920 if (j.lt.nres-1) then
8927 if (l.lt.nres-1) then
8935 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
8936 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
8937 !grad ghalf=0.5d0*ggg1(ll)
8939 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8940 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8941 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
8942 +ekont*derx_turn(ll,2,1)
8943 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8944 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
8945 +ekont*derx_turn(ll,4,1)
8946 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8947 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8948 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8949 !grad ghalf=0.5d0*ggg2(ll)
8951 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
8952 +ekont*derx_turn(ll,2,2)
8953 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8954 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
8955 +ekont*derx_turn(ll,4,2)
8956 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8957 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8958 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8963 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8968 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8974 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8979 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8983 !d write (2,*) iii,g_corr6_loc(iii)
8985 eello_turn6=ekont*eel_turn6
8986 !d write (2,*) 'ekont',ekont
8987 !d write (2,*) 'eel_turn6',ekont*eel_turn6
8989 end function eello_turn6
8990 !-----------------------------------------------------------------------------
8991 subroutine MATVEC2(A1,V1,V2)
8992 !DIR$ INLINEALWAYS MATVEC2
8994 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8996 ! implicit real*8 (a-h,o-z)
8997 ! include 'DIMENSIONS'
8998 real(kind=8),dimension(2) :: V1,V2
8999 real(kind=8),dimension(2,2) :: A1
9000 real(kind=8) :: vaux1,vaux2
9004 ! 3 VI=VI+A1(I,K)*V1(K)
9008 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9009 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9013 end subroutine MATVEC2
9014 !-----------------------------------------------------------------------------
9015 subroutine MATMAT2(A1,A2,A3)
9017 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9019 ! implicit real*8 (a-h,o-z)
9020 ! include 'DIMENSIONS'
9021 real(kind=8),dimension(2,2) :: A1,A2,A3
9022 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
9023 ! DIMENSION AI3(2,2)
9027 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
9033 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9034 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9035 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9036 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9042 end subroutine MATMAT2
9043 !-----------------------------------------------------------------------------
9044 real(kind=8) function scalar2(u,v)
9045 !DIR$ INLINEALWAYS scalar2
9047 real(kind=8),dimension(2) :: u,v
9050 scalar2=u(1)*v(1)+u(2)*v(2)
9052 end function scalar2
9053 !-----------------------------------------------------------------------------
9054 subroutine transpose2(a,at)
9055 !DIR$ INLINEALWAYS transpose2
9057 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
9060 real(kind=8),dimension(2,2) :: a,at
9066 end subroutine transpose2
9067 !-----------------------------------------------------------------------------
9068 subroutine transpose(n,a,at)
9071 real(kind=8),dimension(n,n) :: a,at
9078 end subroutine transpose
9079 !-----------------------------------------------------------------------------
9080 subroutine prodmat3(a1,a2,kk,transp,prod)
9081 !DIR$ INLINEALWAYS prodmat3
9083 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
9087 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
9089 !rc double precision auxmat(2,2),prod_(2,2)
9092 !rc call transpose2(kk(1,1),auxmat(1,1))
9093 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9094 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9096 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
9097 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9098 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
9099 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9100 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
9101 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9102 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
9103 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9106 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9107 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9109 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
9110 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9111 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
9112 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9113 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
9114 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9115 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
9116 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9119 ! call transpose2(a2(1,1),a2t(1,1))
9122 !rc print *,((prod_(i,j),i=1,2),j=1,2)
9123 !rc print *,((prod(i,j),i=1,2),j=1,2)
9126 end subroutine prodmat3
9127 !-----------------------------------------------------------------------------
9128 ! energy_p_new_barrier.F
9129 !-----------------------------------------------------------------------------
9130 subroutine sum_gradient
9131 ! implicit real*8 (a-h,o-z)
9132 use io_base, only: pdbout
9133 ! include 'DIMENSIONS'
9137 !MS$ATTRIBUTES C :: proc_proc
9143 real(kind=8),dimension(3,nres) :: gradbufc,gradbufx,gradbufc_sum,&
9144 gloc_scbuf !(3,maxres)
9146 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
9149 integer :: i,j,k,ierror,ierr
9150 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
9151 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
9152 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
9153 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
9154 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
9155 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
9156 gsccorr_max,gsccorrx_max,time00
9158 ! include 'COMMON.SETUP'
9159 ! include 'COMMON.IOUNITS'
9160 ! include 'COMMON.FFIELD'
9161 ! include 'COMMON.DERIV'
9162 ! include 'COMMON.INTERACT'
9163 ! include 'COMMON.SBRIDGE'
9164 ! include 'COMMON.CHAIN'
9165 ! include 'COMMON.VAR'
9166 ! include 'COMMON.CONTROL'
9167 ! include 'COMMON.TIME1'
9168 ! include 'COMMON.MAXGRAD'
9169 ! include 'COMMON.SCCOR'
9174 write (iout,*) "sum_gradient gvdwc, gvdwx"
9176 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9177 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
9187 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
9188 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
9189 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
9192 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
9193 ! in virtual-bond-vector coordinates
9196 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
9198 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
9199 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
9201 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
9203 ! write (iout,'(i5,3f10.5,2x,f10.5)')
9204 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
9206 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
9208 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9209 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
9210 (gvdwc_scpp(j,i),j=1,3)
9212 write (iout,*) "gelc_long gvdwpp gel_loc_long"
9214 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9215 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
9216 (gelc_loc_long(j,i),j=1,3)
9223 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
9224 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
9225 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
9226 wel_loc*gel_loc_long(j,i)+ &
9227 wcorr*gradcorr_long(j,i)+ &
9228 wcorr5*gradcorr5_long(j,i)+ &
9229 wcorr6*gradcorr6_long(j,i)+ &
9230 wturn6*gcorr6_turn_long(j,i)+ &
9237 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
9238 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
9239 welec*gelc_long(j,i)+ &
9241 wel_loc*gel_loc_long(j,i)+ &
9242 wcorr*gradcorr_long(j,i)+ &
9243 wcorr5*gradcorr5_long(j,i)+ &
9244 wcorr6*gradcorr6_long(j,i)+ &
9245 wturn6*gcorr6_turn_long(j,i)+ &
9251 if (nfgtasks.gt.1) then
9254 write (iout,*) "gradbufc before allreduce"
9256 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9262 gradbufc_sum(j,i)=gradbufc(j,i)
9265 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
9266 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
9267 ! time_reduce=time_reduce+MPI_Wtime()-time00
9269 ! write (iout,*) "gradbufc_sum after allreduce"
9271 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
9276 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
9284 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
9285 write (iout,*) (i," jgrad_start",jgrad_start(i),&
9286 " jgrad_end ",jgrad_end(i),&
9287 i=igrad_start,igrad_end)
9290 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
9291 ! do not parallelize this part.
9293 ! do i=igrad_start,igrad_end
9294 ! do j=jgrad_start(i),jgrad_end(i)
9296 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
9301 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
9305 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
9309 write (iout,*) "gradbufc after summing"
9311 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9319 write (iout,*) "gradbufc"
9321 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9328 gradbufc_sum(j,i)=gradbufc(j,i)
9333 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
9337 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
9342 ! gradbufc(k,i)=0.0d0
9346 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
9352 write (iout,*) "gradbufc after summing"
9354 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9363 gradbufc(k,nres)=0.0d0
9366 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
9367 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
9368 !el-----------------
9372 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
9373 wel_loc*gel_loc(j,i)+ &
9374 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
9375 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
9376 wel_loc*gel_loc_long(j,i)+ &
9377 wcorr*gradcorr_long(j,i)+ &
9378 wcorr5*gradcorr5_long(j,i)+ &
9379 wcorr6*gradcorr6_long(j,i)+ &
9380 wturn6*gcorr6_turn_long(j,i))+ &
9382 wcorr*gradcorr(j,i)+ &
9383 wturn3*gcorr3_turn(j,i)+ &
9384 wturn4*gcorr4_turn(j,i)+ &
9385 wcorr5*gradcorr5(j,i)+ &
9386 wcorr6*gradcorr6(j,i)+ &
9387 wturn6*gcorr6_turn(j,i)+ &
9388 wsccor*gsccorc(j,i) &
9391 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
9392 wel_loc*gel_loc(j,i)+ &
9393 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
9394 welec*gelc_long(j,i)+ &
9395 wel_loc*gel_loc_long(j,i)+ &
9396 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
9397 wcorr5*gradcorr5_long(j,i)+ &
9398 wcorr6*gradcorr6_long(j,i)+ &
9399 wturn6*gcorr6_turn_long(j,i))+ &
9401 wcorr*gradcorr(j,i)+ &
9402 wturn3*gcorr3_turn(j,i)+ &
9403 wturn4*gcorr4_turn(j,i)+ &
9404 wcorr5*gradcorr5(j,i)+ &
9405 wcorr6*gradcorr6(j,i)+ &
9406 wturn6*gcorr6_turn(j,i)+ &
9407 wsccor*gsccorc(j,i) &
9410 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
9411 wbond*gradbx(j,i)+ &
9412 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
9413 wsccor*gsccorx(j,i) &
9414 +wscloc*gsclocx(j,i)
9418 write (iout,*) "gloc before adding corr"
9420 write (iout,*) i,gloc(i,icg)
9424 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
9425 +wcorr5*g_corr5_loc(i) &
9426 +wcorr6*g_corr6_loc(i) &
9427 +wturn4*gel_loc_turn4(i) &
9428 +wturn3*gel_loc_turn3(i) &
9429 +wturn6*gel_loc_turn6(i) &
9430 +wel_loc*gel_loc_loc(i)
9433 write (iout,*) "gloc after adding corr"
9435 write (iout,*) i,gloc(i,icg)
9439 if (nfgtasks.gt.1) then
9442 gradbufc(j,i)=gradc(j,i,icg)
9443 gradbufx(j,i)=gradx(j,i,icg)
9447 glocbuf(i)=gloc(i,icg)
9451 write (iout,*) "gloc_sc before reduce"
9454 write (iout,*) i,j,gloc_sc(j,i,icg)
9461 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
9465 call MPI_Barrier(FG_COMM,IERR)
9466 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
9468 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,&
9469 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9470 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,&
9471 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9472 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
9473 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9474 time_reduce=time_reduce+MPI_Wtime()-time00
9475 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
9476 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9477 time_reduce=time_reduce+MPI_Wtime()-time00
9480 write (iout,*) "gloc_sc after reduce"
9483 write (iout,*) i,j,gloc_sc(j,i,icg)
9489 write (iout,*) "gloc after reduce"
9491 write (iout,*) i,gloc(i,icg)
9496 if (gnorm_check) then
9498 ! Compute the maximum elements of the gradient
9508 gcorr3_turn_max=0.0d0
9509 gcorr4_turn_max=0.0d0
9512 gcorr6_turn_max=0.0d0
9522 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
9523 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
9524 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
9525 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
9526 gvdwc_scp_max=gvdwc_scp_norm
9527 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
9528 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
9529 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
9530 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
9531 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
9532 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
9533 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
9534 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
9535 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
9536 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
9537 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
9538 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
9539 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
9541 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
9542 gcorr3_turn_max=gcorr3_turn_norm
9543 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
9545 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
9546 gcorr4_turn_max=gcorr4_turn_norm
9547 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
9548 if (gradcorr5_norm.gt.gradcorr5_max) &
9549 gradcorr5_max=gradcorr5_norm
9550 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
9551 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
9552 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
9554 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
9555 gcorr6_turn_max=gcorr6_turn_norm
9556 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
9557 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
9558 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
9559 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
9560 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
9561 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
9562 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
9563 if (gradx_scp_norm.gt.gradx_scp_max) &
9564 gradx_scp_max=gradx_scp_norm
9565 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
9566 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
9567 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
9568 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
9569 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
9570 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
9571 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
9572 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
9576 open(istat,file=statname,position="append")
9578 open(istat,file=statname,access="append")
9580 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
9581 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
9582 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
9583 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
9584 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
9585 gsccorx_max,gsclocx_max
9587 if (gvdwc_max.gt.1.0d4) then
9588 write (iout,*) "gvdwc gvdwx gradb gradbx"
9590 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
9591 gradb(j,i),gradbx(j,i),j=1,3)
9593 call pdbout(0.0d0,'cipiszcze',iout)
9600 write (iout,*) "gradc gradx gloc"
9602 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
9603 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
9608 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
9611 end subroutine sum_gradient
9612 !-----------------------------------------------------------------------------
9614 ! implicit real*8 (a-h,o-z)
9616 ! include 'DIMENSIONS'
9617 ! include 'COMMON.CHAIN'
9618 ! include 'COMMON.DERIV'
9619 ! include 'COMMON.CALC'
9620 ! include 'COMMON.IOUNITS'
9621 real(kind=8), dimension(3) :: dcosom1,dcosom2
9623 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
9624 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
9625 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
9626 -2.0D0*alf12*eps3der+sigder*sigsq_om12
9630 ! eom12=evdwij*eps1_om12
9632 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
9634 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
9635 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
9636 !C print *,sss_ele_cut,'in sc_grad'
9638 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
9639 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
9642 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
9643 !C print *,'gg',k,gg(k)
9645 ! write (iout,*) "gg",(gg(k),k=1,3)
9647 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
9648 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
9649 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
9652 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
9653 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
9654 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
9657 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
9658 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
9659 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
9660 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
9663 ! Calculate the components of the gradient in DC and X
9667 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
9671 gvdwc(l,i)=gvdwc(l,i)-gg(l)
9672 gvdwc(l,j)=gvdwc(l,j)+gg(l)
9675 end subroutine sc_grad
9677 !-----------------------------------------------------------------------------
9678 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
9681 ! implicit real*8 (a-h,o-z)
9682 ! include 'DIMENSIONS'
9683 ! include 'COMMON.LOCAL'
9684 ! include 'COMMON.IOUNITS'
9685 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
9686 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
9687 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
9688 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
9689 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
9691 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
9692 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
9693 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
9696 delthec=thetai-thet_pred_mean
9697 delthe0=thetai-theta0i
9698 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
9699 t3 = thetai-thet_pred_mean
9703 t14 = t12+t6*sigsqtc
9705 t21 = thetai-theta0i
9711 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
9712 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
9713 *(-t12*t9-ak*sig0inv*t27)
9715 end subroutine mixder
9717 !-----------------------------------------------------------------------------
9719 !-----------------------------------------------------------------------------
9721 !-----------------------------------------------------------------------------
9722 ! This subroutine calculates the derivatives of the consecutive virtual
9723 ! bond vectors and the SC vectors in the virtual-bond angles theta and
9724 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
9725 ! in the angles alpha and omega, describing the location of a side chain
9726 ! in its local coordinate system.
9728 ! The derivatives are stored in the following arrays:
9730 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
9731 ! The structure is as follows:
9733 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
9734 ! 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)
9735 ! . . . . . . . . . . . . . . . . . .
9736 ! 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)
9740 ! 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)
9742 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
9743 ! The structure is same as above.
9745 ! DCDS - the derivatives of the side chain vectors in the local spherical
9746 ! andgles alph and omega:
9748 ! 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)
9749 ! 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)
9753 ! 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)
9755 ! Version of March '95, based on an early version of November '91.
9757 !**********************************************************************
9758 ! implicit real*8 (a-h,o-z)
9759 ! include 'DIMENSIONS'
9760 ! include 'COMMON.VAR'
9761 ! include 'COMMON.CHAIN'
9762 ! include 'COMMON.DERIV'
9763 ! include 'COMMON.GEO'
9764 ! include 'COMMON.LOCAL'
9765 ! include 'COMMON.INTERACT'
9766 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
9767 real(kind=8),dimension(3,3) :: dp,temp
9768 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
9769 real(kind=8),dimension(3) :: xx,xx1
9771 integer :: i,k,l,j,m,ind,ind1,jjj
9772 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
9773 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
9774 sint2,xp,yp,xxp,yyp,zzp,dj
9776 ! common /przechowalnia/ fromto
9777 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
9778 ! get the position of the jth ijth fragment of the chain coordinate system
9779 ! in the fromto array.
9780 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
9782 ! maxdim=(nres-1)*(nres-2)/2
9783 ! allocate(dcdv(6,maxdim),dxds(6,nres))
9784 ! calculate the derivatives of transformation matrix elements in theta
9787 !el call flush(iout) !el
9789 rdt(1,1,i)=-rt(1,2,i)
9790 rdt(1,2,i)= rt(1,1,i)
9792 rdt(2,1,i)=-rt(2,2,i)
9793 rdt(2,2,i)= rt(2,1,i)
9795 rdt(3,1,i)=-rt(3,2,i)
9796 rdt(3,2,i)= rt(3,1,i)
9800 ! derivatives in phi
9806 drt(2,1,i)= rt(3,1,i)
9807 drt(2,2,i)= rt(3,2,i)
9808 drt(2,3,i)= rt(3,3,i)
9809 drt(3,1,i)=-rt(2,1,i)
9810 drt(3,2,i)=-rt(2,2,i)
9811 drt(3,3,i)=-rt(2,3,i)
9814 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
9825 fromto(k,l,ind)=temp(k,l)
9834 dpkl=dpkl+temp(k,m)*rt(m,l,j)
9837 fromto(k,l,ind)=dpkl
9848 ! Calculate derivatives.
9854 ! Derivatives of DC(i+1) in theta(i+2)
9860 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
9863 prordt(j,k,i)=dp(j,k)
9866 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
9869 ! Derivatives of SC(i+1) in theta(i+2)
9871 xx1(1)=-0.5D0*xloc(2,i+1)
9872 xx1(2)= 0.5D0*xloc(1,i+1)
9876 xj=xj+r(j,k,i)*xx1(k)
9883 rj=rj+prod(j,k,i)*xx(k)
9888 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
9889 ! than the other off-diagonal derivatives.
9894 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
9896 dxdv(j,ind1+1)=dxoiij
9898 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
9900 ! Derivatives of DC(i+1) in phi(i+2)
9906 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
9909 prodrt(j,k,i)=dp(j,k)
9911 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
9914 ! Derivatives of SC(i+1) in phi(i+2)
9917 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
9918 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
9922 rj=rj+prod(j,k,i)*xx(k)
9927 ! Derivatives of SC(i+1) in phi(i+3).
9932 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
9934 dxdv(j+3,ind1+1)=dxoiij
9937 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
9938 ! theta(nres) and phi(i+3) thru phi(nres).
9943 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
9948 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
9953 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
9954 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
9955 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
9956 ! Derivatives of virtual-bond vectors in theta
9958 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
9960 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
9961 ! Derivatives of SC vectors in theta
9965 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
9967 dxdv(k,ind1+1)=dxoijk
9970 !--- Calculate the derivatives in phi
9976 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
9982 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
9987 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
9989 dxdv(k+3,ind1+1)=dxoijk
9994 ! Derivatives in alpha and omega:
9997 ! dsci=dsc(itype(i))
10002 if(alphi.ne.alphi) alphi=100.0
10003 if(omegi.ne.omegi) omegi=-100.0
10008 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
10009 cosalphi=dcos(alphi)
10010 sinalphi=dsin(alphi)
10011 cosomegi=dcos(omegi)
10012 sinomegi=dsin(omegi)
10013 temp(1,1)=-dsci*sinalphi
10014 temp(2,1)= dsci*cosalphi*cosomegi
10015 temp(3,1)=-dsci*cosalphi*sinomegi
10017 temp(2,2)=-dsci*sinalphi*sinomegi
10018 temp(3,2)=-dsci*sinalphi*cosomegi
10019 theta2=pi-0.5D0*theta(i+1)
10023 !d print *,((temp(l,k),l=1,3),k=1,2)
10027 xxp= xp*cost2+yp*sint2
10028 yyp=-xp*sint2+yp*cost2
10031 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
10032 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
10036 dj=dj+prod(k,l,i-1)*xx(l)
10044 end subroutine cartder
10045 !-----------------------------------------------------------------------------
10047 !-----------------------------------------------------------------------------
10048 subroutine check_cartgrad
10049 ! Check the gradient of Cartesian coordinates in internal coordinates.
10050 ! implicit real*8 (a-h,o-z)
10051 ! include 'DIMENSIONS'
10052 ! include 'COMMON.IOUNITS'
10053 ! include 'COMMON.VAR'
10054 ! include 'COMMON.CHAIN'
10055 ! include 'COMMON.GEO'
10056 ! include 'COMMON.LOCAL'
10057 ! include 'COMMON.DERIV'
10058 real(kind=8),dimension(6,nres) :: temp
10059 real(kind=8),dimension(3) :: xx,gg
10060 integer :: i,k,j,ii
10061 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
10062 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
10064 ! Check the gradient of the virtual-bond and SC vectors in the internal
10070 write (iout,'(a)') '**************** dx/dalpha'
10074 alph(i)=alph(i)+aincr
10076 temp(k,i)=dc(k,nres+i)
10080 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
10081 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
10083 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
10084 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
10090 write (iout,'(a)') '**************** dx/domega'
10094 omeg(i)=omeg(i)+aincr
10096 temp(k,i)=dc(k,nres+i)
10100 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
10101 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
10102 (aincr*dabs(dxds(k+3,i))+aincr))
10104 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
10105 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
10111 write (iout,'(a)') '**************** dx/dtheta'
10115 theta(i)=theta(i)+aincr
10118 temp(k,j)=dc(k,nres+j)
10124 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
10126 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
10127 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
10128 (aincr*dabs(dxdv(k,ii))+aincr))
10130 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10131 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
10138 write (iout,'(a)') '***************** dx/dphi'
10141 phi(i)=phi(i)+aincr
10144 temp(k,j)=dc(k,nres+j)
10152 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
10153 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
10154 (aincr*dabs(dxdv(k+3,ii))+aincr))
10156 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10157 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
10160 phi(i)=phi(i)-aincr
10163 write (iout,'(a)') '****************** ddc/dtheta'
10166 theta(i+2)=thet+aincr
10177 gg(k)=(dc(k,j)-temp(k,j))/aincr
10178 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
10179 (aincr*dabs(dcdv(k,ii))+aincr))
10181 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10182 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
10192 write (iout,'(a)') '******************* ddc/dphi'
10195 phi(i+3)=phii+aincr
10206 gg(k)=(dc(k,j)-temp(k,j))/aincr
10207 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
10208 (aincr*dabs(dcdv(k+3,ii))+aincr))
10210 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10211 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
10222 end subroutine check_cartgrad
10223 !-----------------------------------------------------------------------------
10224 subroutine check_ecart
10225 ! Check the gradient of the energy in Cartesian coordinates.
10226 ! implicit real*8 (a-h,o-z)
10227 ! include 'DIMENSIONS'
10228 ! include 'COMMON.CHAIN'
10229 ! include 'COMMON.DERIV'
10230 ! include 'COMMON.IOUNITS'
10231 ! include 'COMMON.VAR'
10232 ! include 'COMMON.CONTACTS'
10234 !el integer :: icall
10235 !el common /srutu/ icall
10236 real(kind=8),dimension(6) :: ggg
10237 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
10238 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10239 real(kind=8),dimension(6,nres) :: grad_s
10240 real(kind=8),dimension(0:n_ene) :: energia,energia1
10241 integer :: uiparm(1)
10242 real(kind=8) :: urparm(1)
10244 integer :: nf,i,j,k
10245 real(kind=8) :: aincr,etot,etot1
10251 print '(a)','CG processor',me,' calling CHECK_CART.'
10254 call geom_to_var(nvar,x)
10255 call etotal(energia)
10257 !el call enerprint(energia)
10258 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
10261 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10265 grad_s(j,i)=gradc(j,i,icg)
10266 grad_s(j+3,i)=gradx(j,i,icg)
10270 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10275 ddx(j)=dc(j,i+nres)
10278 dc(j,i)=dc(j,i)+aincr
10280 c(j,k)=c(j,k)+aincr
10281 c(j,k+nres)=c(j,k+nres)+aincr
10283 call etotal(energia1)
10285 ggg(j)=(etot1-etot)/aincr
10288 c(j,k)=c(j,k)-aincr
10289 c(j,k+nres)=c(j,k+nres)-aincr
10293 c(j,i+nres)=c(j,i+nres)+aincr
10294 dc(j,i+nres)=dc(j,i+nres)+aincr
10295 call etotal(energia1)
10297 ggg(j+3)=(etot1-etot)/aincr
10299 dc(j,i+nres)=ddx(j)
10301 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
10302 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
10305 end subroutine check_ecart
10307 !-----------------------------------------------------------------------------
10308 subroutine check_ecartint
10309 ! Check the gradient of the energy in Cartesian coordinates.
10310 use io_base, only: intout
10311 ! implicit real*8 (a-h,o-z)
10312 ! include 'DIMENSIONS'
10313 ! include 'COMMON.CONTROL'
10314 ! include 'COMMON.CHAIN'
10315 ! include 'COMMON.DERIV'
10316 ! include 'COMMON.IOUNITS'
10317 ! include 'COMMON.VAR'
10318 ! include 'COMMON.CONTACTS'
10319 ! include 'COMMON.MD'
10320 ! include 'COMMON.LOCAL'
10321 ! include 'COMMON.SPLITELE'
10323 !el integer :: icall
10324 !el common /srutu/ icall
10325 real(kind=8),dimension(6) :: ggg,ggg1
10326 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
10327 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10328 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
10329 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
10330 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
10331 real(kind=8),dimension(0:n_ene) :: energia,energia1
10332 integer :: uiparm(1)
10333 real(kind=8) :: urparm(1)
10335 integer :: i,j,k,nf
10336 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
10344 ! call intcartderiv
10345 ! call checkintcartgrad
10348 write(iout,*) 'Calling CHECK_ECARTINT.'
10351 write (iout,*) "Before geom_to_var"
10352 call geom_to_var(nvar,x)
10353 write (iout,*) "after geom_to_var"
10354 write (iout,*) "split_ene ",split_ene
10356 if (.not.split_ene) then
10357 write(iout,*) 'Calling CHECK_ECARTINT if'
10358 call etotal(energia)
10359 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
10361 write (iout,*) "etot",etot
10363 !el call enerprint(energia)
10364 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
10366 write (iout,*) "enter cartgrad"
10369 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
10370 write (iout,*) "exit cartgrad"
10374 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10377 grad_s(j,0)=gcart(j,0)
10379 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
10382 grad_s(j,i)=gcart(j,i)
10383 grad_s(j+3,i)=gxcart(j,i)
10387 write(iout,*) 'Calling CHECK_ECARTIN else.'
10388 !- split gradient check
10390 call etotal_long(energia)
10391 !el call enerprint(energia)
10393 write (iout,*) "enter cartgrad"
10396 write (iout,*) "exit cartgrad"
10399 write (iout,*) "longrange grad"
10401 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10402 (gxcart(j,i),j=1,3)
10405 grad_s(j,0)=gcart(j,0)
10409 grad_s(j,i)=gcart(j,i)
10410 grad_s(j+3,i)=gxcart(j,i)
10414 call etotal_short(energia)
10415 !el call enerprint(energia)
10417 write (iout,*) "enter cartgrad"
10420 write (iout,*) "exit cartgrad"
10423 write (iout,*) "shortrange grad"
10425 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10426 (gxcart(j,i),j=1,3)
10429 grad_s1(j,0)=gcart(j,0)
10433 grad_s1(j,i)=gcart(j,i)
10434 grad_s1(j+3,i)=gxcart(j,i)
10438 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10442 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
10443 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
10446 dcnorm_safe1(j)=dc_norm(j,i-1)
10447 dcnorm_safe2(j)=dc_norm(j,i)
10448 dxnorm_safe(j)=dc_norm(j,i+nres)
10451 c(j,i)=ddc(j)+aincr
10452 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
10453 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
10454 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
10455 dc(j,i)=c(j,i+1)-c(j,i)
10456 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10457 call int_from_cart1(.false.)
10458 if (.not.split_ene) then
10459 call etotal(energia1)
10461 write (iout,*) "ij",i,j," etot1",etot1
10464 call etotal_long(energia1)
10466 call etotal_short(energia1)
10469 !- end split gradient
10470 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10471 c(j,i)=ddc(j)-aincr
10472 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
10473 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
10474 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
10475 dc(j,i)=c(j,i+1)-c(j,i)
10476 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10477 call int_from_cart1(.false.)
10478 if (.not.split_ene) then
10479 call etotal(energia1)
10481 write (iout,*) "ij",i,j," etot2",etot2
10482 ggg(j)=(etot1-etot2)/(2*aincr)
10485 call etotal_long(energia1)
10487 ggg(j)=(etot11-etot21)/(2*aincr)
10488 call etotal_short(energia1)
10490 ggg1(j)=(etot12-etot22)/(2*aincr)
10491 !- end split gradient
10492 ! write (iout,*) "etot21",etot21," etot22",etot22
10494 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10496 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
10497 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
10498 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
10499 dc(j,i)=c(j,i+1)-c(j,i)
10500 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10501 dc_norm(j,i-1)=dcnorm_safe1(j)
10502 dc_norm(j,i)=dcnorm_safe2(j)
10503 dc_norm(j,i+nres)=dxnorm_safe(j)
10506 c(j,i+nres)=ddx(j)+aincr
10507 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10508 call int_from_cart1(.false.)
10509 if (.not.split_ene) then
10510 call etotal(energia1)
10514 call etotal_long(energia1)
10516 call etotal_short(energia1)
10519 !- end split gradient
10520 c(j,i+nres)=ddx(j)-aincr
10521 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10522 call int_from_cart1(.false.)
10523 if (.not.split_ene) then
10524 call etotal(energia1)
10526 ggg(j+3)=(etot1-etot2)/(2*aincr)
10529 call etotal_long(energia1)
10531 ggg(j+3)=(etot11-etot21)/(2*aincr)
10532 call etotal_short(energia1)
10534 ggg1(j+3)=(etot12-etot22)/(2*aincr)
10535 !- end split gradient
10537 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10539 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10540 dc_norm(j,i+nres)=dxnorm_safe(j)
10541 call int_from_cart1(.false.)
10543 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10544 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
10545 if (split_ene) then
10546 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10547 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
10549 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10550 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
10551 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
10555 end subroutine check_ecartint
10557 !-----------------------------------------------------------------------------
10558 subroutine check_ecartint
10559 ! Check the gradient of the energy in Cartesian coordinates.
10560 use io_base, only: intout
10561 ! implicit real*8 (a-h,o-z)
10562 ! include 'DIMENSIONS'
10563 ! include 'COMMON.CONTROL'
10564 ! include 'COMMON.CHAIN'
10565 ! include 'COMMON.DERIV'
10566 ! include 'COMMON.IOUNITS'
10567 ! include 'COMMON.VAR'
10568 ! include 'COMMON.CONTACTS'
10569 ! include 'COMMON.MD'
10570 ! include 'COMMON.LOCAL'
10571 ! include 'COMMON.SPLITELE'
10573 !el integer :: icall
10574 !el common /srutu/ icall
10575 real(kind=8),dimension(6) :: ggg,ggg1
10576 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
10577 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10578 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
10579 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
10580 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
10581 real(kind=8),dimension(0:n_ene) :: energia,energia1
10582 integer :: uiparm(1)
10583 real(kind=8) :: urparm(1)
10585 integer :: i,j,k,nf
10586 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
10594 ! call intcartderiv
10595 ! call checkintcartgrad
10598 write(iout,*) 'Calling CHECK_ECARTINT.'
10601 call geom_to_var(nvar,x)
10602 if (.not.split_ene) then
10603 call etotal(energia)
10605 !el call enerprint(energia)
10607 write (iout,*) "enter cartgrad"
10610 write (iout,*) "exit cartgrad"
10614 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10617 grad_s(j,0)=gcart(j,0)
10621 grad_s(j,i)=gcart(j,i)
10622 grad_s(j+3,i)=gxcart(j,i)
10626 !- split gradient check
10628 call etotal_long(energia)
10629 !el call enerprint(energia)
10631 write (iout,*) "enter cartgrad"
10634 write (iout,*) "exit cartgrad"
10637 write (iout,*) "longrange grad"
10639 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10640 (gxcart(j,i),j=1,3)
10643 grad_s(j,0)=gcart(j,0)
10647 grad_s(j,i)=gcart(j,i)
10648 grad_s(j+3,i)=gxcart(j,i)
10652 call etotal_short(energia)
10653 !el call enerprint(energia)
10655 write (iout,*) "enter cartgrad"
10658 write (iout,*) "exit cartgrad"
10661 write (iout,*) "shortrange grad"
10663 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10664 (gxcart(j,i),j=1,3)
10667 grad_s1(j,0)=gcart(j,0)
10671 grad_s1(j,i)=gcart(j,i)
10672 grad_s1(j+3,i)=gxcart(j,i)
10676 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10681 ddx(j)=dc(j,i+nres)
10683 dcnorm_safe(k)=dc_norm(k,i)
10684 dxnorm_safe(k)=dc_norm(k,i+nres)
10688 dc(j,i)=ddc(j)+aincr
10689 call chainbuild_cart
10691 ! Broadcast the order to compute internal coordinates to the slaves.
10692 ! if (nfgtasks.gt.1)
10693 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
10695 ! call int_from_cart1(.false.)
10696 if (.not.split_ene) then
10697 call etotal(energia1)
10701 call etotal_long(energia1)
10703 call etotal_short(energia1)
10705 ! write (iout,*) "etot11",etot11," etot12",etot12
10707 !- end split gradient
10708 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10709 dc(j,i)=ddc(j)-aincr
10710 call chainbuild_cart
10711 ! call int_from_cart1(.false.)
10712 if (.not.split_ene) then
10713 call etotal(energia1)
10715 ggg(j)=(etot1-etot2)/(2*aincr)
10718 call etotal_long(energia1)
10720 ggg(j)=(etot11-etot21)/(2*aincr)
10721 call etotal_short(energia1)
10723 ggg1(j)=(etot12-etot22)/(2*aincr)
10724 !- end split gradient
10725 ! write (iout,*) "etot21",etot21," etot22",etot22
10727 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10729 call chainbuild_cart
10732 dc(j,i+nres)=ddx(j)+aincr
10733 call chainbuild_cart
10734 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
10735 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
10736 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
10737 ! write (iout,*) "dxnormnorm",dsqrt(
10738 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
10739 ! write (iout,*) "dxnormnormsafe",dsqrt(
10740 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
10742 if (.not.split_ene) then
10743 call etotal(energia1)
10747 call etotal_long(energia1)
10749 call etotal_short(energia1)
10752 !- end split gradient
10753 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10754 dc(j,i+nres)=ddx(j)-aincr
10755 call chainbuild_cart
10756 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
10757 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
10758 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
10760 ! write (iout,*) "dxnormnorm",dsqrt(
10761 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
10762 ! write (iout,*) "dxnormnormsafe",dsqrt(
10763 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
10764 if (.not.split_ene) then
10765 call etotal(energia1)
10767 ggg(j+3)=(etot1-etot2)/(2*aincr)
10770 call etotal_long(energia1)
10772 ggg(j+3)=(etot11-etot21)/(2*aincr)
10773 call etotal_short(energia1)
10775 ggg1(j+3)=(etot12-etot22)/(2*aincr)
10776 !- end split gradient
10778 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10779 dc(j,i+nres)=ddx(j)
10780 call chainbuild_cart
10782 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10783 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
10784 if (split_ene) then
10785 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10786 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
10788 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10789 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
10790 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
10794 end subroutine check_ecartint
10796 !-----------------------------------------------------------------------------
10797 subroutine check_eint
10798 ! Check the gradient of energy in internal coordinates.
10799 ! implicit real*8 (a-h,o-z)
10800 ! include 'DIMENSIONS'
10801 ! include 'COMMON.CHAIN'
10802 ! include 'COMMON.DERIV'
10803 ! include 'COMMON.IOUNITS'
10804 ! include 'COMMON.VAR'
10805 ! include 'COMMON.GEO'
10807 !el integer :: icall
10808 !el common /srutu/ icall
10809 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
10810 integer :: uiparm(1)
10811 real(kind=8) :: urparm(1)
10812 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
10813 character(len=6) :: key
10816 real(kind=8) :: xi,aincr,etot,etot1,etot2
10819 print '(a)','Calling CHECK_INT.'
10823 call geom_to_var(nvar,x)
10824 call var_to_geom(nvar,x)
10828 call etotal(energia)
10830 !el call enerprint(energia)
10833 if (MyID.ne.BossID) then
10834 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
10842 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
10843 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
10844 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
10848 x(i)=xi-0.5D0*aincr
10849 call var_to_geom(nvar,x)
10851 call etotal(energia1)
10853 x(i)=xi+0.5D0*aincr
10854 call var_to_geom(nvar,x)
10856 call etotal(energia2)
10858 gg(i)=(etot2-etot1)/aincr
10859 write (iout,*) i,etot1,etot2
10862 write (iout,'(/2a)')' Variable Numerical Analytical',&
10865 if (i.le.nphi) then
10868 else if (i.le.nphi+ntheta) then
10871 else if (i.le.nphi+ntheta+nside) then
10875 ii=i-(nphi+ntheta+nside)
10878 write (iout,'(i3,a,i3,3(1pd16.6))') &
10879 i,key,ii,gg(i),gana(i),&
10880 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
10883 end subroutine check_eint
10884 !-----------------------------------------------------------------------------
10886 !-----------------------------------------------------------------------------
10887 subroutine Econstr_back
10888 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
10889 ! implicit real*8 (a-h,o-z)
10890 ! include 'DIMENSIONS'
10891 ! include 'COMMON.CONTROL'
10892 ! include 'COMMON.VAR'
10893 ! include 'COMMON.MD'
10896 ! include 'COMMON.LANGEVIN'
10898 ! include 'COMMON.LANGEVIN.lang0'
10900 ! include 'COMMON.CHAIN'
10901 ! include 'COMMON.DERIV'
10902 ! include 'COMMON.GEO'
10903 ! include 'COMMON.LOCAL'
10904 ! include 'COMMON.INTERACT'
10905 ! include 'COMMON.IOUNITS'
10906 ! include 'COMMON.NAMES'
10907 ! include 'COMMON.TIME1'
10908 integer :: i,j,ii,k
10909 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
10911 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
10912 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
10913 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
10920 duscdiff(j,i)=0.0d0
10921 duscdiffx(j,i)=0.0d0
10925 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
10927 ! Deviations from theta angles
10930 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
10931 dtheta_i=theta(j)-thetaref(j)
10932 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
10933 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
10935 utheta(i)=utheta_i/(ii-1)
10937 ! Deviations from gamma angles
10940 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
10941 dgamma_i=pinorm(phi(j)-phiref(j))
10942 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
10943 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
10944 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
10945 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
10947 ugamma(i)=ugamma_i/(ii-2)
10949 ! Deviations from local SC geometry
10952 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
10953 dxx=xxtab(j)-xxref(j)
10954 dyy=yytab(j)-yyref(j)
10955 dzz=zztab(j)-zzref(j)
10956 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
10958 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
10959 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
10961 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
10962 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
10964 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
10965 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
10968 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
10969 ! & xxref(j),yyref(j),zzref(j)
10971 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
10972 ! write (iout,*) i," uscdiff",uscdiff(i)
10974 ! Put together deviations from local geometry
10976 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
10977 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
10978 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
10979 ! & " uconst_back",uconst_back
10980 utheta(i)=dsqrt(utheta(i))
10981 ugamma(i)=dsqrt(ugamma(i))
10982 uscdiff(i)=dsqrt(uscdiff(i))
10985 end subroutine Econstr_back
10986 !-----------------------------------------------------------------------------
10987 ! energy_p_new-sep_barrier.F
10988 !-----------------------------------------------------------------------------
10989 real(kind=8) function sscale(r)
10990 ! include "COMMON.SPLITELE"
10991 real(kind=8) :: r,gamm
10992 if(r.lt.r_cut-rlamb) then
10994 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10995 gamm=(r-(r_cut-rlamb))/rlamb
10996 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
11001 end function sscale
11002 !!!!!!!!!! PBCSCALE
11003 real(kind=8) function sscale_ele(r)
11004 ! include "COMMON.SPLITELE"
11005 real(kind=8) :: r,gamm
11006 if(r.lt.r_cut_ele-rlamb_ele) then
11008 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
11009 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
11010 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
11015 end function sscale_ele
11017 real(kind=8) function sscagrad_ele(r)
11018 real(kind=8) :: r,gamm
11019 ! include "COMMON.SPLITELE"
11020 if(r.lt.r_cut_ele-rlamb_ele) then
11022 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
11023 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
11024 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
11029 end function sscagrad_ele
11031 !-----------------------------------------------------------------------------
11032 subroutine elj_long(evdw)
11034 ! This subroutine calculates the interaction energy of nonbonded side chains
11035 ! assuming the LJ 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.INTERACT'
11045 ! include 'COMMON.TORSION'
11046 ! include 'COMMON.SBRIDGE'
11047 ! include 'COMMON.NAMES'
11048 ! include 'COMMON.IOUNITS'
11049 ! include 'COMMON.CONTACTS'
11050 real(kind=8),parameter :: accur=1.0d-10
11051 real(kind=8),dimension(3) :: gg
11052 !el local variables
11053 integer :: i,iint,j,k,itypi,itypi1,itypj
11054 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
11055 real(kind=8) :: e1,e2,evdwij,evdw
11056 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
11058 do i=iatsc_s,iatsc_e
11060 if (itypi.eq.ntyp1) cycle
11066 ! Calculate SC interaction energy.
11068 do iint=1,nint_gr(i)
11069 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
11070 !d & 'iend=',iend(i,iint)
11071 do j=istart(i,iint),iend(i,iint)
11073 if (itypj.eq.ntyp1) cycle
11077 rij=xj*xj+yj*yj+zj*zj
11078 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
11079 if (sss.lt.1.0d0) then
11081 eps0ij=eps(itypi,itypj)
11083 e1=fac*fac*aa(itypi,itypj)
11084 e2=fac*bb(itypi,itypj)
11086 evdw=evdw+(1.0d0-sss)*evdwij
11088 ! Calculate the components of the gradient in DC and X
11090 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
11095 gvdwx(k,i)=gvdwx(k,i)-gg(k)
11096 gvdwx(k,j)=gvdwx(k,j)+gg(k)
11097 gvdwc(k,i)=gvdwc(k,i)-gg(k)
11098 gvdwc(k,j)=gvdwc(k,j)+gg(k)
11106 gvdwc(j,i)=expon*gvdwc(j,i)
11107 gvdwx(j,i)=expon*gvdwx(j,i)
11110 !******************************************************************************
11114 ! To save time, the factor of EXPON has been extracted from ALL components
11115 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
11118 !******************************************************************************
11120 end subroutine elj_long
11121 !-----------------------------------------------------------------------------
11122 subroutine elj_short(evdw)
11124 ! This subroutine calculates the interaction energy of nonbonded side chains
11125 ! assuming the LJ potential of interaction.
11127 ! implicit real*8 (a-h,o-z)
11128 ! include 'DIMENSIONS'
11129 ! include 'COMMON.GEO'
11130 ! include 'COMMON.VAR'
11131 ! include 'COMMON.LOCAL'
11132 ! include 'COMMON.CHAIN'
11133 ! include 'COMMON.DERIV'
11134 ! include 'COMMON.INTERACT'
11135 ! include 'COMMON.TORSION'
11136 ! include 'COMMON.SBRIDGE'
11137 ! include 'COMMON.NAMES'
11138 ! include 'COMMON.IOUNITS'
11139 ! include 'COMMON.CONTACTS'
11140 real(kind=8),parameter :: accur=1.0d-10
11141 real(kind=8),dimension(3) :: gg
11142 !el local variables
11143 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
11144 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
11145 real(kind=8) :: e1,e2,evdwij,evdw
11146 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
11148 do i=iatsc_s,iatsc_e
11150 if (itypi.eq.ntyp1) cycle
11158 ! Calculate SC interaction energy.
11160 do iint=1,nint_gr(i)
11161 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
11162 !d & 'iend=',iend(i,iint)
11163 do j=istart(i,iint),iend(i,iint)
11165 if (itypj.eq.ntyp1) cycle
11169 ! Change 12/1/95 to calculate four-body interactions
11170 rij=xj*xj+yj*yj+zj*zj
11171 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
11172 if (sss.gt.0.0d0) then
11174 eps0ij=eps(itypi,itypj)
11176 e1=fac*fac*aa(itypi,itypj)
11177 e2=fac*bb(itypi,itypj)
11179 evdw=evdw+sss*evdwij
11181 ! Calculate the components of the gradient in DC and X
11183 fac=-rrij*(e1+evdwij)*sss
11188 gvdwx(k,i)=gvdwx(k,i)-gg(k)
11189 gvdwx(k,j)=gvdwx(k,j)+gg(k)
11190 gvdwc(k,i)=gvdwc(k,i)-gg(k)
11191 gvdwc(k,j)=gvdwc(k,j)+gg(k)
11199 gvdwc(j,i)=expon*gvdwc(j,i)
11200 gvdwx(j,i)=expon*gvdwx(j,i)
11203 !******************************************************************************
11207 ! To save time, the factor of EXPON has been extracted from ALL components
11208 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
11211 !******************************************************************************
11213 end subroutine elj_short
11214 !-----------------------------------------------------------------------------
11215 subroutine eljk_long(evdw)
11217 ! This subroutine calculates the interaction energy of nonbonded side chains
11218 ! assuming the LJK potential of interaction.
11220 ! implicit real*8 (a-h,o-z)
11221 ! include 'DIMENSIONS'
11222 ! include 'COMMON.GEO'
11223 ! include 'COMMON.VAR'
11224 ! include 'COMMON.LOCAL'
11225 ! include 'COMMON.CHAIN'
11226 ! include 'COMMON.DERIV'
11227 ! include 'COMMON.INTERACT'
11228 ! include 'COMMON.IOUNITS'
11229 ! include 'COMMON.NAMES'
11230 real(kind=8),dimension(3) :: gg
11232 !el local variables
11233 integer :: i,iint,j,k,itypi,itypi1,itypj
11234 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
11235 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
11236 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
11238 do i=iatsc_s,iatsc_e
11240 if (itypi.eq.ntyp1) cycle
11246 ! Calculate SC interaction energy.
11248 do iint=1,nint_gr(i)
11249 do j=istart(i,iint),iend(i,iint)
11251 if (itypj.eq.ntyp1) cycle
11255 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11256 fac_augm=rrij**expon
11257 e_augm=augm(itypi,itypj)*fac_augm
11258 r_inv_ij=dsqrt(rrij)
11260 sss=sscale(rij/sigma(itypi,itypj))
11261 if (sss.lt.1.0d0) then
11262 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
11263 fac=r_shift_inv**expon
11264 e1=fac*fac*aa(itypi,itypj)
11265 e2=fac*bb(itypi,itypj)
11266 evdwij=e_augm+e1+e2
11267 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11268 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11269 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
11270 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
11271 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
11272 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
11273 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
11274 evdw=evdw+(1.0d0-sss)*evdwij
11276 ! Calculate the components of the gradient in DC and X
11278 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
11279 fac=fac*(1.0d0-sss)
11284 gvdwx(k,i)=gvdwx(k,i)-gg(k)
11285 gvdwx(k,j)=gvdwx(k,j)+gg(k)
11286 gvdwc(k,i)=gvdwc(k,i)-gg(k)
11287 gvdwc(k,j)=gvdwc(k,j)+gg(k)
11295 gvdwc(j,i)=expon*gvdwc(j,i)
11296 gvdwx(j,i)=expon*gvdwx(j,i)
11300 end subroutine eljk_long
11301 !-----------------------------------------------------------------------------
11302 subroutine eljk_short(evdw)
11304 ! This subroutine calculates the interaction energy of nonbonded side chains
11305 ! assuming the LJK potential of interaction.
11307 ! implicit real*8 (a-h,o-z)
11308 ! include 'DIMENSIONS'
11309 ! include 'COMMON.GEO'
11310 ! include 'COMMON.VAR'
11311 ! include 'COMMON.LOCAL'
11312 ! include 'COMMON.CHAIN'
11313 ! include 'COMMON.DERIV'
11314 ! include 'COMMON.INTERACT'
11315 ! include 'COMMON.IOUNITS'
11316 ! include 'COMMON.NAMES'
11317 real(kind=8),dimension(3) :: gg
11319 !el local variables
11320 integer :: i,iint,j,k,itypi,itypi1,itypj
11321 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
11322 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
11323 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
11325 do i=iatsc_s,iatsc_e
11327 if (itypi.eq.ntyp1) cycle
11333 ! Calculate SC interaction energy.
11335 do iint=1,nint_gr(i)
11336 do j=istart(i,iint),iend(i,iint)
11338 if (itypj.eq.ntyp1) cycle
11342 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11343 fac_augm=rrij**expon
11344 e_augm=augm(itypi,itypj)*fac_augm
11345 r_inv_ij=dsqrt(rrij)
11347 sss=sscale(rij/sigma(itypi,itypj))
11348 if (sss.gt.0.0d0) then
11349 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
11350 fac=r_shift_inv**expon
11351 e1=fac*fac*aa(itypi,itypj)
11352 e2=fac*bb(itypi,itypj)
11353 evdwij=e_augm+e1+e2
11354 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11355 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11356 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
11357 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
11358 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
11359 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
11360 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
11361 evdw=evdw+sss*evdwij
11363 ! Calculate the components of the gradient in DC and X
11365 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
11371 gvdwx(k,i)=gvdwx(k,i)-gg(k)
11372 gvdwx(k,j)=gvdwx(k,j)+gg(k)
11373 gvdwc(k,i)=gvdwc(k,i)-gg(k)
11374 gvdwc(k,j)=gvdwc(k,j)+gg(k)
11382 gvdwc(j,i)=expon*gvdwc(j,i)
11383 gvdwx(j,i)=expon*gvdwx(j,i)
11387 end subroutine eljk_short
11388 !-----------------------------------------------------------------------------
11389 subroutine ebp_long(evdw)
11391 ! This subroutine calculates the interaction energy of nonbonded side chains
11392 ! assuming the Berne-Pechukas potential of interaction.
11395 ! implicit real*8 (a-h,o-z)
11396 ! include 'DIMENSIONS'
11397 ! include 'COMMON.GEO'
11398 ! include 'COMMON.VAR'
11399 ! include 'COMMON.LOCAL'
11400 ! include 'COMMON.CHAIN'
11401 ! include 'COMMON.DERIV'
11402 ! include 'COMMON.NAMES'
11403 ! include 'COMMON.INTERACT'
11404 ! include 'COMMON.IOUNITS'
11405 ! include 'COMMON.CALC'
11407 !el integer :: icall
11408 !el common /srutu/ icall
11409 ! double precision rrsave(maxdim)
11411 !el local variables
11412 integer :: iint,itypi,itypi1,itypj
11413 real(kind=8) :: rrij,xi,yi,zi,fac
11414 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
11416 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
11418 ! if (icall.eq.0) then
11424 do i=iatsc_s,iatsc_e
11426 if (itypi.eq.ntyp1) cycle
11431 dxi=dc_norm(1,nres+i)
11432 dyi=dc_norm(2,nres+i)
11433 dzi=dc_norm(3,nres+i)
11434 ! dsci_inv=dsc_inv(itypi)
11435 dsci_inv=vbld_inv(i+nres)
11437 ! Calculate SC interaction energy.
11439 do iint=1,nint_gr(i)
11440 do j=istart(i,iint),iend(i,iint)
11443 if (itypj.eq.ntyp1) cycle
11444 ! dscj_inv=dsc_inv(itypj)
11445 dscj_inv=vbld_inv(j+nres)
11446 chi1=chi(itypi,itypj)
11447 chi2=chi(itypj,itypi)
11454 alf12=0.5D0*(alf1+alf2)
11458 dxj=dc_norm(1,nres+j)
11459 dyj=dc_norm(2,nres+j)
11460 dzj=dc_norm(3,nres+j)
11461 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11463 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11465 if (sss.lt.1.0d0) then
11467 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
11469 ! Calculate whole angle-dependent part of epsilon and contributions
11470 ! to its derivatives
11471 fac=(rrij*sigsq)**expon2
11472 e1=fac*fac*aa(itypi,itypj)
11473 e2=fac*bb(itypi,itypj)
11474 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11475 eps2der=evdwij*eps3rt
11476 eps3der=evdwij*eps2rt
11477 evdwij=evdwij*eps2rt*eps3rt
11478 evdw=evdw+evdwij*(1.0d0-sss)
11480 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11481 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11482 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
11483 !d & restyp(itypi),i,restyp(itypj),j,
11484 !d & epsi,sigm,chi1,chi2,chip1,chip2,
11485 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
11486 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
11489 ! Calculate gradient components.
11490 e1=e1*eps1*eps2rt**2*eps3rt**2
11491 fac=-expon*(e1+evdwij)
11494 ! Calculate radial part of the gradient
11498 ! Calculate the angular part of the gradient and sum add the contributions
11499 ! to the appropriate components of the Cartesian gradient.
11500 call sc_grad_scale(1.0d0-sss)
11507 end subroutine ebp_long
11508 !-----------------------------------------------------------------------------
11509 subroutine ebp_short(evdw)
11511 ! This subroutine calculates the interaction energy of nonbonded side chains
11512 ! assuming the Berne-Pechukas potential of interaction.
11515 ! implicit real*8 (a-h,o-z)
11516 ! include 'DIMENSIONS'
11517 ! include 'COMMON.GEO'
11518 ! include 'COMMON.VAR'
11519 ! include 'COMMON.LOCAL'
11520 ! include 'COMMON.CHAIN'
11521 ! include 'COMMON.DERIV'
11522 ! include 'COMMON.NAMES'
11523 ! include 'COMMON.INTERACT'
11524 ! include 'COMMON.IOUNITS'
11525 ! include 'COMMON.CALC'
11527 !el integer :: icall
11528 !el common /srutu/ icall
11529 ! double precision rrsave(maxdim)
11531 !el local variables
11532 integer :: iint,itypi,itypi1,itypj
11533 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
11534 real(kind=8) :: sss,e1,e2,evdw
11536 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
11538 ! if (icall.eq.0) then
11544 do i=iatsc_s,iatsc_e
11546 if (itypi.eq.ntyp1) cycle
11551 dxi=dc_norm(1,nres+i)
11552 dyi=dc_norm(2,nres+i)
11553 dzi=dc_norm(3,nres+i)
11554 ! dsci_inv=dsc_inv(itypi)
11555 dsci_inv=vbld_inv(i+nres)
11557 ! Calculate SC interaction energy.
11559 do iint=1,nint_gr(i)
11560 do j=istart(i,iint),iend(i,iint)
11563 if (itypj.eq.ntyp1) cycle
11564 ! dscj_inv=dsc_inv(itypj)
11565 dscj_inv=vbld_inv(j+nres)
11566 chi1=chi(itypi,itypj)
11567 chi2=chi(itypj,itypi)
11574 alf12=0.5D0*(alf1+alf2)
11578 dxj=dc_norm(1,nres+j)
11579 dyj=dc_norm(2,nres+j)
11580 dzj=dc_norm(3,nres+j)
11581 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11583 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11585 if (sss.gt.0.0d0) then
11587 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
11589 ! Calculate whole angle-dependent part of epsilon and contributions
11590 ! to its derivatives
11591 fac=(rrij*sigsq)**expon2
11592 e1=fac*fac*aa(itypi,itypj)
11593 e2=fac*bb(itypi,itypj)
11594 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11595 eps2der=evdwij*eps3rt
11596 eps3der=evdwij*eps2rt
11597 evdwij=evdwij*eps2rt*eps3rt
11598 evdw=evdw+evdwij*sss
11600 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11601 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11602 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
11603 !d & restyp(itypi),i,restyp(itypj),j,
11604 !d & epsi,sigm,chi1,chi2,chip1,chip2,
11605 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
11606 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
11609 ! Calculate gradient components.
11610 e1=e1*eps1*eps2rt**2*eps3rt**2
11611 fac=-expon*(e1+evdwij)
11614 ! Calculate radial part of the gradient
11618 ! Calculate the angular part of the gradient and sum add the contributions
11619 ! to the appropriate components of the Cartesian gradient.
11620 call sc_grad_scale(sss)
11627 end subroutine ebp_short
11628 !-----------------------------------------------------------------------------
11629 subroutine egb_long(evdw)
11631 ! This subroutine calculates the interaction energy of nonbonded side chains
11632 ! assuming the Gay-Berne potential of interaction.
11635 ! implicit real*8 (a-h,o-z)
11636 ! include 'DIMENSIONS'
11637 ! include 'COMMON.GEO'
11638 ! include 'COMMON.VAR'
11639 ! include 'COMMON.LOCAL'
11640 ! include 'COMMON.CHAIN'
11641 ! include 'COMMON.DERIV'
11642 ! include 'COMMON.NAMES'
11643 ! include 'COMMON.INTERACT'
11644 ! include 'COMMON.IOUNITS'
11645 ! include 'COMMON.CALC'
11646 ! include 'COMMON.CONTROL'
11648 !el local variables
11649 integer :: iint,itypi,itypi1,itypj,subchap
11650 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
11651 real(kind=8) :: sss,e1,e2,evdw
11652 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
11653 dist_temp, dist_init
11656 !cccc energy_dec=.false.
11657 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11660 ! if (icall.eq.0) lprn=.false.
11662 do i=iatsc_s,iatsc_e
11664 if (itypi.eq.ntyp1) cycle
11669 xi=mod(xi,boxxsize)
11670 if (xi.lt.0) xi=xi+boxxsize
11671 yi=mod(yi,boxysize)
11672 if (yi.lt.0) yi=yi+boxysize
11673 zi=mod(zi,boxzsize)
11674 if (zi.lt.0) zi=zi+boxzsize
11675 dxi=dc_norm(1,nres+i)
11676 dyi=dc_norm(2,nres+i)
11677 dzi=dc_norm(3,nres+i)
11678 ! dsci_inv=dsc_inv(itypi)
11679 dsci_inv=vbld_inv(i+nres)
11680 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
11681 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
11683 ! Calculate SC interaction energy.
11685 do iint=1,nint_gr(i)
11686 do j=istart(i,iint),iend(i,iint)
11689 if (itypj.eq.ntyp1) cycle
11690 ! dscj_inv=dsc_inv(itypj)
11691 dscj_inv=vbld_inv(j+nres)
11692 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
11693 ! & 1.0d0/vbld(j+nres)
11694 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
11695 sig0ij=sigma(itypi,itypj)
11696 chi1=chi(itypi,itypj)
11697 chi2=chi(itypj,itypi)
11704 alf12=0.5D0*(alf1+alf2)
11708 ! Searching for nearest neighbour
11709 xj=mod(xj,boxxsize)
11710 if (xj.lt.0) xj=xj+boxxsize
11711 yj=mod(yj,boxysize)
11712 if (yj.lt.0) yj=yj+boxysize
11713 zj=mod(zj,boxzsize)
11714 if (zj.lt.0) zj=zj+boxzsize
11715 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
11723 xj=xj_safe+xshift*boxxsize
11724 yj=yj_safe+yshift*boxysize
11725 zj=zj_safe+zshift*boxzsize
11726 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
11727 if(dist_temp.lt.dist_init) then
11728 dist_init=dist_temp
11737 if (subchap.eq.1) then
11747 dxj=dc_norm(1,nres+j)
11748 dyj=dc_norm(2,nres+j)
11749 dzj=dc_norm(3,nres+j)
11750 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11752 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11753 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
11754 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
11755 if (sss_ele_cut.le.0.0) cycle
11756 if (sss.lt.1.0d0) then
11758 ! Calculate angle-dependent terms of energy and contributions to their
11762 sig=sig0ij*dsqrt(sigsq)
11763 rij_shift=1.0D0/rij-sig+sig0ij
11764 ! for diagnostics; uncomment
11765 ! rij_shift=1.2*sig0ij
11766 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11767 if (rij_shift.le.0.0D0) then
11769 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
11770 !d & restyp(itypi),i,restyp(itypj),j,
11771 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
11775 !---------------------------------------------------------------
11776 rij_shift=1.0D0/rij_shift
11777 fac=rij_shift**expon
11778 e1=fac*fac*aa(itypi,itypj)
11779 e2=fac*bb(itypi,itypj)
11780 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11781 eps2der=evdwij*eps3rt
11782 eps3der=evdwij*eps2rt
11783 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
11784 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
11785 evdwij=evdwij*eps2rt*eps3rt
11786 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
11788 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11789 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11790 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11791 restyp(itypi),i,restyp(itypj),j,&
11792 epsi,sigm,chi1,chi2,chip1,chip2,&
11793 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
11794 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11798 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
11800 ! if (energy_dec) write (iout,*) &
11801 ! 'evdw',i,j,evdwij,"egb_long"
11803 ! Calculate gradient components.
11804 e1=e1*eps1*eps2rt**2*eps3rt**2
11805 fac=-expon*(e1+evdwij)*rij_shift
11808 fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
11809 /sigma(itypi,itypj)*rij
11811 ! Calculate the radial part of the gradient
11815 ! Calculate angular part of the gradient.
11816 call sc_grad_scale(1.0d0-sss)
11821 ! write (iout,*) "Number of loop steps in EGB:",ind
11822 !ccc energy_dec=.false.
11824 end subroutine egb_long
11825 !-----------------------------------------------------------------------------
11826 subroutine egb_short(evdw)
11828 ! This subroutine calculates the interaction energy of nonbonded side chains
11829 ! assuming the Gay-Berne potential of interaction.
11832 ! implicit real*8 (a-h,o-z)
11833 ! include 'DIMENSIONS'
11834 ! include 'COMMON.GEO'
11835 ! include 'COMMON.VAR'
11836 ! include 'COMMON.LOCAL'
11837 ! include 'COMMON.CHAIN'
11838 ! include 'COMMON.DERIV'
11839 ! include 'COMMON.NAMES'
11840 ! include 'COMMON.INTERACT'
11841 ! include 'COMMON.IOUNITS'
11842 ! include 'COMMON.CALC'
11843 ! include 'COMMON.CONTROL'
11845 !el local variables
11846 integer :: iint,itypi,itypi1,itypj,subchap
11847 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
11848 real(kind=8) :: sss,e1,e2,evdw,rij_shift
11849 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
11850 dist_temp, dist_init
11852 !cccc energy_dec=.false.
11853 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11856 ! if (icall.eq.0) lprn=.false.
11858 do i=iatsc_s,iatsc_e
11860 if (itypi.eq.ntyp1) cycle
11865 xi=mod(xi,boxxsize)
11866 if (xi.lt.0) xi=xi+boxxsize
11867 yi=mod(yi,boxysize)
11868 if (yi.lt.0) yi=yi+boxysize
11869 zi=mod(zi,boxzsize)
11870 if (zi.lt.0) zi=zi+boxzsize
11871 dxi=dc_norm(1,nres+i)
11872 dyi=dc_norm(2,nres+i)
11873 dzi=dc_norm(3,nres+i)
11874 ! dsci_inv=dsc_inv(itypi)
11875 dsci_inv=vbld_inv(i+nres)
11877 dxi=dc_norm(1,nres+i)
11878 dyi=dc_norm(2,nres+i)
11879 dzi=dc_norm(3,nres+i)
11880 ! dsci_inv=dsc_inv(itypi)
11881 dsci_inv=vbld_inv(i+nres)
11882 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
11883 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
11885 ! Calculate SC interaction energy.
11887 do iint=1,nint_gr(i)
11888 do j=istart(i,iint),iend(i,iint)
11891 if (itypj.eq.ntyp1) cycle
11892 ! dscj_inv=dsc_inv(itypj)
11893 dscj_inv=vbld_inv(j+nres)
11894 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
11895 ! & 1.0d0/vbld(j+nres)
11896 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
11897 sig0ij=sigma(itypi,itypj)
11898 chi1=chi(itypi,itypj)
11899 chi2=chi(itypj,itypi)
11906 alf12=0.5D0*(alf1+alf2)
11907 ! xj=c(1,nres+j)-xi
11908 ! yj=c(2,nres+j)-yi
11909 ! zj=c(3,nres+j)-zi
11913 ! Searching for nearest neighbour
11914 xj=mod(xj,boxxsize)
11915 if (xj.lt.0) xj=xj+boxxsize
11916 yj=mod(yj,boxysize)
11917 if (yj.lt.0) yj=yj+boxysize
11918 zj=mod(zj,boxzsize)
11919 if (zj.lt.0) zj=zj+boxzsize
11920 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
11928 xj=xj_safe+xshift*boxxsize
11929 yj=yj_safe+yshift*boxysize
11930 zj=zj_safe+zshift*boxzsize
11931 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
11932 if(dist_temp.lt.dist_init) then
11933 dist_init=dist_temp
11942 if (subchap.eq.1) then
11952 dxj=dc_norm(1,nres+j)
11953 dyj=dc_norm(2,nres+j)
11954 dzj=dc_norm(3,nres+j)
11955 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11957 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11958 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
11959 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
11960 if (sss_ele_cut.le.0.0) cycle
11962 if (sss.gt.0.0d0) then
11964 ! Calculate angle-dependent terms of energy and contributions to their
11968 sig=sig0ij*dsqrt(sigsq)
11969 rij_shift=1.0D0/rij-sig+sig0ij
11970 ! for diagnostics; uncomment
11971 ! rij_shift=1.2*sig0ij
11972 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11973 if (rij_shift.le.0.0D0) then
11975 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
11976 !d & restyp(itypi),i,restyp(itypj),j,
11977 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
11981 !---------------------------------------------------------------
11982 rij_shift=1.0D0/rij_shift
11983 fac=rij_shift**expon
11984 e1=fac*fac*aa(itypi,itypj)
11985 e2=fac*bb(itypi,itypj)
11986 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11987 eps2der=evdwij*eps3rt
11988 eps3der=evdwij*eps2rt
11989 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
11990 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
11991 evdwij=evdwij*eps2rt*eps3rt
11992 evdw=evdw+evdwij*sss
11994 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11995 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11996 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11997 restyp(itypi),i,restyp(itypj),j,&
11998 epsi,sigm,chi1,chi2,chip1,chip2,&
11999 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
12000 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
12004 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
12006 ! if (energy_dec) write (iout,*) &
12007 ! 'evdw',i,j,evdwij,"egb_short"
12009 ! Calculate gradient components.
12010 e1=e1*eps1*eps2rt**2*eps3rt**2
12011 fac=-expon*(e1+evdwij)*rij_shift
12014 fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
12015 /sigma(itypi,itypj)*rij
12018 ! Calculate the radial part of the gradient
12022 ! Calculate angular part of the gradient.
12023 call sc_grad_scale(sss)
12028 ! write (iout,*) "Number of loop steps in EGB:",ind
12029 !ccc energy_dec=.false.
12031 end subroutine egb_short
12032 !-----------------------------------------------------------------------------
12033 subroutine egbv_long(evdw)
12035 ! This subroutine calculates the interaction energy of nonbonded side chains
12036 ! assuming the Gay-Berne-Vorobjev potential of interaction.
12039 ! implicit real*8 (a-h,o-z)
12040 ! include 'DIMENSIONS'
12041 ! include 'COMMON.GEO'
12042 ! include 'COMMON.VAR'
12043 ! include 'COMMON.LOCAL'
12044 ! include 'COMMON.CHAIN'
12045 ! include 'COMMON.DERIV'
12046 ! include 'COMMON.NAMES'
12047 ! include 'COMMON.INTERACT'
12048 ! include 'COMMON.IOUNITS'
12049 ! include 'COMMON.CALC'
12051 !el integer :: icall
12052 !el common /srutu/ icall
12054 !el local variables
12055 integer :: iint,itypi,itypi1,itypj
12056 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
12057 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
12059 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
12062 ! if (icall.eq.0) lprn=.true.
12064 do i=iatsc_s,iatsc_e
12066 if (itypi.eq.ntyp1) cycle
12071 dxi=dc_norm(1,nres+i)
12072 dyi=dc_norm(2,nres+i)
12073 dzi=dc_norm(3,nres+i)
12074 ! dsci_inv=dsc_inv(itypi)
12075 dsci_inv=vbld_inv(i+nres)
12077 ! Calculate SC interaction energy.
12079 do iint=1,nint_gr(i)
12080 do j=istart(i,iint),iend(i,iint)
12083 if (itypj.eq.ntyp1) cycle
12084 ! dscj_inv=dsc_inv(itypj)
12085 dscj_inv=vbld_inv(j+nres)
12086 sig0ij=sigma(itypi,itypj)
12087 r0ij=r0(itypi,itypj)
12088 chi1=chi(itypi,itypj)
12089 chi2=chi(itypj,itypi)
12096 alf12=0.5D0*(alf1+alf2)
12100 dxj=dc_norm(1,nres+j)
12101 dyj=dc_norm(2,nres+j)
12102 dzj=dc_norm(3,nres+j)
12103 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12106 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12108 if (sss.lt.1.0d0) then
12110 ! Calculate angle-dependent terms of energy and contributions to their
12114 sig=sig0ij*dsqrt(sigsq)
12115 rij_shift=1.0D0/rij-sig+r0ij
12116 ! I hate to put IF's in the loops, but here don't have another choice!!!!
12117 if (rij_shift.le.0.0D0) then
12122 !---------------------------------------------------------------
12123 rij_shift=1.0D0/rij_shift
12124 fac=rij_shift**expon
12125 e1=fac*fac*aa(itypi,itypj)
12126 e2=fac*bb(itypi,itypj)
12127 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12128 eps2der=evdwij*eps3rt
12129 eps3der=evdwij*eps2rt
12130 fac_augm=rrij**expon
12131 e_augm=augm(itypi,itypj)*fac_augm
12132 evdwij=evdwij*eps2rt*eps3rt
12133 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
12135 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12136 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12137 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
12138 restyp(itypi),i,restyp(itypj),j,&
12139 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
12140 chi1,chi2,chip1,chip2,&
12141 eps1,eps2rt**2,eps3rt**2,&
12142 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
12145 ! Calculate gradient components.
12146 e1=e1*eps1*eps2rt**2*eps3rt**2
12147 fac=-expon*(e1+evdwij)*rij_shift
12149 fac=rij*fac-2*expon*rrij*e_augm
12150 ! Calculate the radial part of the gradient
12154 ! Calculate angular part of the gradient.
12155 call sc_grad_scale(1.0d0-sss)
12160 end subroutine egbv_long
12161 !-----------------------------------------------------------------------------
12162 subroutine egbv_short(evdw)
12164 ! This subroutine calculates the interaction energy of nonbonded side chains
12165 ! assuming the Gay-Berne-Vorobjev potential of interaction.
12168 ! implicit real*8 (a-h,o-z)
12169 ! include 'DIMENSIONS'
12170 ! include 'COMMON.GEO'
12171 ! include 'COMMON.VAR'
12172 ! include 'COMMON.LOCAL'
12173 ! include 'COMMON.CHAIN'
12174 ! include 'COMMON.DERIV'
12175 ! include 'COMMON.NAMES'
12176 ! include 'COMMON.INTERACT'
12177 ! include 'COMMON.IOUNITS'
12178 ! include 'COMMON.CALC'
12180 !el integer :: icall
12181 !el common /srutu/ icall
12183 !el local variables
12184 integer :: iint,itypi,itypi1,itypj
12185 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
12186 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
12188 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
12191 ! if (icall.eq.0) lprn=.true.
12193 do i=iatsc_s,iatsc_e
12195 if (itypi.eq.ntyp1) cycle
12200 dxi=dc_norm(1,nres+i)
12201 dyi=dc_norm(2,nres+i)
12202 dzi=dc_norm(3,nres+i)
12203 ! dsci_inv=dsc_inv(itypi)
12204 dsci_inv=vbld_inv(i+nres)
12206 ! Calculate SC interaction energy.
12208 do iint=1,nint_gr(i)
12209 do j=istart(i,iint),iend(i,iint)
12212 if (itypj.eq.ntyp1) cycle
12213 ! dscj_inv=dsc_inv(itypj)
12214 dscj_inv=vbld_inv(j+nres)
12215 sig0ij=sigma(itypi,itypj)
12216 r0ij=r0(itypi,itypj)
12217 chi1=chi(itypi,itypj)
12218 chi2=chi(itypj,itypi)
12225 alf12=0.5D0*(alf1+alf2)
12229 dxj=dc_norm(1,nres+j)
12230 dyj=dc_norm(2,nres+j)
12231 dzj=dc_norm(3,nres+j)
12232 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12235 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12237 if (sss.gt.0.0d0) then
12239 ! Calculate angle-dependent terms of energy and contributions to their
12243 sig=sig0ij*dsqrt(sigsq)
12244 rij_shift=1.0D0/rij-sig+r0ij
12245 ! I hate to put IF's in the loops, but here don't have another choice!!!!
12246 if (rij_shift.le.0.0D0) then
12251 !---------------------------------------------------------------
12252 rij_shift=1.0D0/rij_shift
12253 fac=rij_shift**expon
12254 e1=fac*fac*aa(itypi,itypj)
12255 e2=fac*bb(itypi,itypj)
12256 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12257 eps2der=evdwij*eps3rt
12258 eps3der=evdwij*eps2rt
12259 fac_augm=rrij**expon
12260 e_augm=augm(itypi,itypj)*fac_augm
12261 evdwij=evdwij*eps2rt*eps3rt
12262 evdw=evdw+(evdwij+e_augm)*sss
12264 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12265 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12266 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
12267 restyp(itypi),i,restyp(itypj),j,&
12268 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
12269 chi1,chi2,chip1,chip2,&
12270 eps1,eps2rt**2,eps3rt**2,&
12271 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
12274 ! Calculate gradient components.
12275 e1=e1*eps1*eps2rt**2*eps3rt**2
12276 fac=-expon*(e1+evdwij)*rij_shift
12278 fac=rij*fac-2*expon*rrij*e_augm
12279 ! Calculate the radial part of the gradient
12283 ! Calculate angular part of the gradient.
12284 call sc_grad_scale(sss)
12289 end subroutine egbv_short
12290 !-----------------------------------------------------------------------------
12291 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
12293 ! This subroutine calculates the average interaction energy and its gradient
12294 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
12295 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
12296 ! The potential depends both on the distance of peptide-group centers and on
12297 ! the orientation of the CA-CA virtual bonds.
12299 ! implicit real*8 (a-h,o-z)
12305 ! include 'DIMENSIONS'
12306 ! include 'COMMON.CONTROL'
12307 ! include 'COMMON.SETUP'
12308 ! include 'COMMON.IOUNITS'
12309 ! include 'COMMON.GEO'
12310 ! include 'COMMON.VAR'
12311 ! include 'COMMON.LOCAL'
12312 ! include 'COMMON.CHAIN'
12313 ! include 'COMMON.DERIV'
12314 ! include 'COMMON.INTERACT'
12315 ! include 'COMMON.CONTACTS'
12316 ! include 'COMMON.TORSION'
12317 ! include 'COMMON.VECTORS'
12318 ! include 'COMMON.FFIELD'
12319 ! include 'COMMON.TIME1'
12320 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
12321 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
12322 real(kind=8),dimension(2,2) :: acipa !el,a_temp
12323 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
12324 real(kind=8),dimension(4) :: muij
12325 !el integer :: num_conti,j1,j2
12326 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
12327 !el dz_normi,xmedi,ymedi,zmedi
12328 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
12329 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
12330 !el num_conti,j1,j2
12331 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
12333 real(kind=8) :: scal_el=1.0d0
12335 real(kind=8) :: scal_el=0.5d0
12338 ! 13-go grudnia roku pamietnego...
12339 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
12340 0.0d0,1.0d0,0.0d0,&
12341 0.0d0,0.0d0,1.0d0/),shape(unmat))
12342 !el local variables
12344 real(kind=8) :: fac
12345 real(kind=8) :: dxj,dyj,dzj
12346 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
12348 ! allocate(num_cont_hb(nres)) !(maxres)
12349 !d write(iout,*) 'In EELEC'
12351 !d write(iout,*) 'Type',i
12352 !d write(iout,*) 'B1',B1(:,i)
12353 !d write(iout,*) 'B2',B2(:,i)
12354 !d write(iout,*) 'CC',CC(:,:,i)
12355 !d write(iout,*) 'DD',DD(:,:,i)
12356 !d write(iout,*) 'EE',EE(:,:,i)
12358 !d call check_vecgrad
12360 if (icheckgrad.eq.1) then
12362 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
12364 dc_norm(k,i)=dc(k,i)*fac
12366 ! write (iout,*) 'i',i,' fac',fac
12369 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
12370 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
12371 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
12372 ! call vec_and_deriv
12378 time_mat=time_mat+MPI_Wtime()-time01
12382 !d write (iout,*) 'i=',i
12384 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
12387 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
12388 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
12401 !d print '(a)','Enter EELEC'
12402 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
12403 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
12404 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
12406 gel_loc_loc(i)=0.0d0
12411 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
12413 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
12415 do i=iturn3_start,iturn3_end
12416 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1 &
12417 .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
12421 dx_normi=dc_norm(1,i)
12422 dy_normi=dc_norm(2,i)
12423 dz_normi=dc_norm(3,i)
12424 xmedi=c(1,i)+0.5d0*dxi
12425 ymedi=c(2,i)+0.5d0*dyi
12426 zmedi=c(3,i)+0.5d0*dzi
12428 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
12429 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
12430 num_cont_hb(i)=num_conti
12432 do i=iturn4_start,iturn4_end
12433 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
12434 .or. itype(i+3).eq.ntyp1 &
12435 .or. itype(i+4).eq.ntyp1) cycle
12439 dx_normi=dc_norm(1,i)
12440 dy_normi=dc_norm(2,i)
12441 dz_normi=dc_norm(3,i)
12442 xmedi=c(1,i)+0.5d0*dxi
12443 ymedi=c(2,i)+0.5d0*dyi
12444 zmedi=c(3,i)+0.5d0*dzi
12445 num_conti=num_cont_hb(i)
12446 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
12447 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
12448 call eturn4(i,eello_turn4)
12449 num_cont_hb(i)=num_conti
12452 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
12454 do i=iatel_s,iatel_e
12455 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
12459 dx_normi=dc_norm(1,i)
12460 dy_normi=dc_norm(2,i)
12461 dz_normi=dc_norm(3,i)
12462 xmedi=c(1,i)+0.5d0*dxi
12463 ymedi=c(2,i)+0.5d0*dyi
12464 zmedi=c(3,i)+0.5d0*dzi
12465 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
12466 num_conti=num_cont_hb(i)
12467 do j=ielstart(i),ielend(i)
12468 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
12469 call eelecij_scale(i,j,ees,evdw1,eel_loc)
12471 num_cont_hb(i)=num_conti
12473 ! write (iout,*) "Number of loop steps in EELEC:",ind
12475 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
12476 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
12478 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
12479 !cc eel_loc=eel_loc+eello_turn3
12480 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
12482 end subroutine eelec_scale
12483 !-----------------------------------------------------------------------------
12484 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
12485 ! implicit real*8 (a-h,o-z)
12488 ! include 'DIMENSIONS'
12492 ! include 'COMMON.CONTROL'
12493 ! include 'COMMON.IOUNITS'
12494 ! include 'COMMON.GEO'
12495 ! include 'COMMON.VAR'
12496 ! include 'COMMON.LOCAL'
12497 ! include 'COMMON.CHAIN'
12498 ! include 'COMMON.DERIV'
12499 ! include 'COMMON.INTERACT'
12500 ! include 'COMMON.CONTACTS'
12501 ! include 'COMMON.TORSION'
12502 ! include 'COMMON.VECTORS'
12503 ! include 'COMMON.FFIELD'
12504 ! include 'COMMON.TIME1'
12505 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
12506 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
12507 real(kind=8),dimension(2,2) :: acipa !el,a_temp
12508 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
12509 real(kind=8),dimension(4) :: muij
12510 !el integer :: num_conti,j1,j2
12511 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
12512 !el dz_normi,xmedi,ymedi,zmedi
12513 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
12514 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
12515 !el num_conti,j1,j2
12516 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
12518 real(kind=8) :: scal_el=1.0d0
12520 real(kind=8) :: scal_el=0.5d0
12523 ! 13-go grudnia roku pamietnego...
12524 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
12525 0.0d0,1.0d0,0.0d0,&
12526 0.0d0,0.0d0,1.0d0/),shape(unmat))
12527 !el local variables
12528 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m
12529 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
12530 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
12531 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
12532 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
12533 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
12534 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
12535 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
12536 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
12537 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
12538 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
12539 ecosam,ecosbm,ecosgm,ghalf,time00
12540 ! integer :: maxconts
12541 ! maxconts = nres/4
12542 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12543 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12544 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12545 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12546 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12547 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12548 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12549 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12550 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
12551 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
12552 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
12553 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
12554 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
12556 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
12557 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
12562 !d write (iout,*) "eelecij",i,j
12566 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
12567 aaa=app(iteli,itelj)
12568 bbb=bpp(iteli,itelj)
12569 ael6i=ael6(iteli,itelj)
12570 ael3i=ael3(iteli,itelj)
12574 dx_normj=dc_norm(1,j)
12575 dy_normj=dc_norm(2,j)
12576 dz_normj=dc_norm(3,j)
12577 xj=c(1,j)+0.5D0*dxj-xmedi
12578 yj=c(2,j)+0.5D0*dyj-ymedi
12579 zj=c(3,j)+0.5D0*dzj-zmedi
12580 rij=xj*xj+yj*yj+zj*zj
12584 ! For extracting the short-range part of Evdwpp
12585 sss=sscale(rij/rpp(iteli,itelj))
12589 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
12590 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
12591 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
12592 fac=cosa-3.0D0*cosb*cosg
12594 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
12595 if (j.eq.i+2) ev1=scal_el*ev1
12600 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
12603 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
12604 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
12606 evdw1=evdw1+evdwij*(1.0d0-sss)
12607 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
12608 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
12609 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
12610 !d & xmedi,ymedi,zmedi,xj,yj,zj
12612 if (energy_dec) then
12613 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
12614 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
12618 ! Calculate contributions to the Cartesian gradient.
12621 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)
12622 facel=-3*rrmij*(el1+eesij)
12628 ! Radial derivatives. First process both termini of the fragment (i,j)
12634 ! ghalf=0.5D0*ggg(k)
12635 ! gelc(k,i)=gelc(k,i)+ghalf
12636 ! gelc(k,j)=gelc(k,j)+ghalf
12638 ! 9/28/08 AL Gradient compotents will be summed only at the end
12640 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
12641 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
12644 ! Loop over residues i+1 thru j-1.
12648 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12655 ! ghalf=0.5D0*ggg(k)
12656 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
12657 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
12659 ! 9/28/08 AL Gradient compotents will be summed only at the end
12661 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12662 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12665 ! Loop over residues i+1 thru j-1.
12669 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
12673 facvdw=ev1+evdwij*(1.0d0-sss)
12676 fac=-3*rrmij*(facvdw+facvdw+facel)
12681 ! Radial derivatives. First process both termini of the fragment (i,j)
12687 ! ghalf=0.5D0*ggg(k)
12688 ! gelc(k,i)=gelc(k,i)+ghalf
12689 ! gelc(k,j)=gelc(k,j)+ghalf
12691 ! 9/28/08 AL Gradient compotents will be summed only at the end
12693 gelc_long(k,j)=gelc(k,j)+ggg(k)
12694 gelc_long(k,i)=gelc(k,i)-ggg(k)
12697 ! Loop over residues i+1 thru j-1.
12701 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12704 ! 9/28/08 AL Gradient compotents will be summed only at the end
12709 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12710 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12716 ecosa=2.0D0*fac3*fac1+fac4
12719 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
12720 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
12722 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
12723 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
12725 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
12726 !d & (dcosg(k),k=1,3)
12728 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
12731 ! ghalf=0.5D0*ggg(k)
12732 ! gelc(k,i)=gelc(k,i)+ghalf
12733 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
12734 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12735 ! gelc(k,j)=gelc(k,j)+ghalf
12736 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
12737 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12741 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12745 gelc(k,i)=gelc(k,i) &
12746 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
12747 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12748 gelc(k,j)=gelc(k,j) &
12749 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
12750 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12751 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
12752 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
12754 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
12755 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
12756 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
12758 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
12759 ! energy of a peptide unit is assumed in the form of a second-order
12760 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
12761 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
12762 ! are computed for EVERY pair of non-contiguous peptide groups.
12764 if (j.lt.nres-1) then
12775 muij(kkk)=mu(k,i)*mu(l,j)
12778 !d write (iout,*) 'EELEC: i',i,' j',j
12779 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
12780 !d write(iout,*) 'muij',muij
12781 ury=scalar(uy(1,i),erij)
12782 urz=scalar(uz(1,i),erij)
12783 vry=scalar(uy(1,j),erij)
12784 vrz=scalar(uz(1,j),erij)
12785 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
12786 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
12787 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
12788 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
12789 fac=dsqrt(-ael6i)*r3ij
12794 !d write (iout,'(4i5,4f10.5)')
12795 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
12796 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
12797 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
12798 !d & uy(:,j),uz(:,j)
12799 !d write (iout,'(4f10.5)')
12800 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
12801 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
12802 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
12803 !d write (iout,'(9f10.5/)')
12804 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
12805 ! Derivatives of the elements of A in virtual-bond vectors
12806 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
12808 uryg(k,1)=scalar(erder(1,k),uy(1,i))
12809 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
12810 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
12811 urzg(k,1)=scalar(erder(1,k),uz(1,i))
12812 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
12813 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
12814 vryg(k,1)=scalar(erder(1,k),uy(1,j))
12815 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
12816 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
12817 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
12818 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
12819 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
12821 ! Compute radial contributions to the gradient
12839 ! Add the contributions coming from er
12842 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
12843 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
12844 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
12845 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
12848 ! Derivatives in DC(i)
12849 !grad ghalf1=0.5d0*agg(k,1)
12850 !grad ghalf2=0.5d0*agg(k,2)
12851 !grad ghalf3=0.5d0*agg(k,3)
12852 !grad ghalf4=0.5d0*agg(k,4)
12853 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
12854 -3.0d0*uryg(k,2)*vry)!+ghalf1
12855 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
12856 -3.0d0*uryg(k,2)*vrz)!+ghalf2
12857 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
12858 -3.0d0*urzg(k,2)*vry)!+ghalf3
12859 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
12860 -3.0d0*urzg(k,2)*vrz)!+ghalf4
12861 ! Derivatives in DC(i+1)
12862 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
12863 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
12864 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
12865 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
12866 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
12867 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
12868 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
12869 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
12870 ! Derivatives in DC(j)
12871 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
12872 -3.0d0*vryg(k,2)*ury)!+ghalf1
12873 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
12874 -3.0d0*vrzg(k,2)*ury)!+ghalf2
12875 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
12876 -3.0d0*vryg(k,2)*urz)!+ghalf3
12877 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
12878 -3.0d0*vrzg(k,2)*urz)!+ghalf4
12879 ! Derivatives in DC(j+1) or DC(nres-1)
12880 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
12881 -3.0d0*vryg(k,3)*ury)
12882 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
12883 -3.0d0*vrzg(k,3)*ury)
12884 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
12885 -3.0d0*vryg(k,3)*urz)
12886 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
12887 -3.0d0*vrzg(k,3)*urz)
12888 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
12890 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
12903 aggi(k,l)=-aggi(k,l)
12904 aggi1(k,l)=-aggi1(k,l)
12905 aggj(k,l)=-aggj(k,l)
12906 aggj1(k,l)=-aggj1(k,l)
12909 if (j.lt.nres-1) then
12915 aggi(k,l)=-aggi(k,l)
12916 aggi1(k,l)=-aggi1(k,l)
12917 aggj(k,l)=-aggj(k,l)
12918 aggj1(k,l)=-aggj1(k,l)
12929 aggi(k,l)=-aggi(k,l)
12930 aggi1(k,l)=-aggi1(k,l)
12931 aggj(k,l)=-aggj(k,l)
12932 aggj1(k,l)=-aggj1(k,l)
12937 IF (wel_loc.gt.0.0d0) THEN
12938 ! Contribution to the local-electrostatic energy coming from the i-j pair
12939 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
12941 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
12943 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
12944 'eelloc',i,j,eel_loc_ij
12945 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
12947 eel_loc=eel_loc+eel_loc_ij
12948 ! Partial derivatives in virtual-bond dihedral angles gamma
12950 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
12951 a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
12952 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
12953 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
12954 a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
12955 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
12956 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
12958 ggg(l)=agg(l,1)*muij(1)+ &
12959 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
12960 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
12961 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
12962 !grad ghalf=0.5d0*ggg(l)
12963 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
12964 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
12968 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
12971 ! Remaining derivatives of eello
12973 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ &
12974 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
12975 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ &
12976 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
12977 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ &
12978 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
12979 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ &
12980 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
12983 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
12984 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
12985 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
12986 .and. num_conti.le.maxconts) then
12987 ! write (iout,*) i,j," entered corr"
12989 ! Calculate the contact function. The ith column of the array JCONT will
12990 ! contain the numbers of atoms that make contacts with the atom I (of numbers
12991 ! greater than I). The arrays FACONT and GACONT will contain the values of
12992 ! the contact function and its derivative.
12993 ! r0ij=1.02D0*rpp(iteli,itelj)
12994 ! r0ij=1.11D0*rpp(iteli,itelj)
12995 r0ij=2.20D0*rpp(iteli,itelj)
12996 ! r0ij=1.55D0*rpp(iteli,itelj)
12997 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
12998 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
12999 if (fcont.gt.0.0D0) then
13000 num_conti=num_conti+1
13001 if (num_conti.gt.maxconts) then
13002 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
13003 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
13004 ' will skip next contacts for this conf.',num_conti
13006 jcont_hb(num_conti,i)=j
13007 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
13008 !d & " jcont_hb",jcont_hb(num_conti,i)
13009 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
13010 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
13011 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
13013 d_cont(num_conti,i)=rij
13014 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
13015 ! --- Electrostatic-interaction matrix ---
13016 a_chuj(1,1,num_conti,i)=a22
13017 a_chuj(1,2,num_conti,i)=a23
13018 a_chuj(2,1,num_conti,i)=a32
13019 a_chuj(2,2,num_conti,i)=a33
13020 ! --- Gradient of rij
13022 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
13029 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
13030 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
13031 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
13032 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
13033 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
13038 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
13039 ! Calculate contact energies
13041 wij=cosa-3.0D0*cosb*cosg
13044 ! fac3=dsqrt(-ael6i)/r0ij**3
13045 fac3=dsqrt(-ael6i)*r3ij
13046 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
13047 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
13048 if (ees0tmp.gt.0) then
13049 ees0pij=dsqrt(ees0tmp)
13053 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
13054 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
13055 if (ees0tmp.gt.0) then
13056 ees0mij=dsqrt(ees0tmp)
13061 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
13062 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
13063 ! Diagnostics. Comment out or remove after debugging!
13064 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
13065 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
13066 ! ees0m(num_conti,i)=0.0D0
13068 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
13069 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
13070 ! Angular derivatives of the contact function
13071 ees0pij1=fac3/ees0pij
13072 ees0mij1=fac3/ees0mij
13073 fac3p=-3.0D0*fac3*rrmij
13074 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
13075 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
13077 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
13078 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
13079 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
13080 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
13081 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
13082 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
13083 ecosap=ecosa1+ecosa2
13084 ecosbp=ecosb1+ecosb2
13085 ecosgp=ecosg1+ecosg2
13086 ecosam=ecosa1-ecosa2
13087 ecosbm=ecosb1-ecosb2
13088 ecosgm=ecosg1-ecosg2
13097 facont_hb(num_conti,i)=fcont
13098 fprimcont=fprimcont/rij
13099 !d facont_hb(num_conti,i)=1.0D0
13100 ! Following line is for diagnostics.
13103 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
13104 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
13107 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
13108 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
13110 gggp(1)=gggp(1)+ees0pijp*xj
13111 gggp(2)=gggp(2)+ees0pijp*yj
13112 gggp(3)=gggp(3)+ees0pijp*zj
13113 gggm(1)=gggm(1)+ees0mijp*xj
13114 gggm(2)=gggm(2)+ees0mijp*yj
13115 gggm(3)=gggm(3)+ees0mijp*zj
13116 ! Derivatives due to the contact function
13117 gacont_hbr(1,num_conti,i)=fprimcont*xj
13118 gacont_hbr(2,num_conti,i)=fprimcont*yj
13119 gacont_hbr(3,num_conti,i)=fprimcont*zj
13122 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
13123 ! following the change of gradient-summation algorithm.
13125 !grad ghalfp=0.5D0*gggp(k)
13126 !grad ghalfm=0.5D0*gggm(k)
13127 gacontp_hb1(k,num_conti,i)= & !ghalfp
13128 +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
13129 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
13130 gacontp_hb2(k,num_conti,i)= & !ghalfp
13131 +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
13132 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
13133 gacontp_hb3(k,num_conti,i)=gggp(k)
13134 gacontm_hb1(k,num_conti,i)= &!ghalfm
13135 +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
13136 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
13137 gacontm_hb2(k,num_conti,i)= & !ghalfm
13138 +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
13139 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
13140 gacontm_hb3(k,num_conti,i)=gggm(k)
13143 endif ! num_conti.le.maxconts
13146 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
13149 ghalf=0.5d0*agg(l,k)
13150 aggi(l,k)=aggi(l,k)+ghalf
13151 aggi1(l,k)=aggi1(l,k)+agg(l,k)
13152 aggj(l,k)=aggj(l,k)+ghalf
13155 if (j.eq.nres-1 .and. i.lt.j-2) then
13158 aggj1(l,k)=aggj1(l,k)+agg(l,k)
13163 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
13165 end subroutine eelecij_scale
13166 !-----------------------------------------------------------------------------
13167 subroutine evdwpp_short(evdw1)
13171 ! implicit real*8 (a-h,o-z)
13172 ! include 'DIMENSIONS'
13173 ! include 'COMMON.CONTROL'
13174 ! include 'COMMON.IOUNITS'
13175 ! include 'COMMON.GEO'
13176 ! include 'COMMON.VAR'
13177 ! include 'COMMON.LOCAL'
13178 ! include 'COMMON.CHAIN'
13179 ! include 'COMMON.DERIV'
13180 ! include 'COMMON.INTERACT'
13181 ! include 'COMMON.CONTACTS'
13182 ! include 'COMMON.TORSION'
13183 ! include 'COMMON.VECTORS'
13184 ! include 'COMMON.FFIELD'
13185 real(kind=8),dimension(3) :: ggg
13186 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13188 real(kind=8) :: scal_el=1.0d0
13190 real(kind=8) :: scal_el=0.5d0
13192 !el local variables
13193 integer :: i,j,k,iteli,itelj,num_conti
13194 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
13195 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
13196 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13197 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
13200 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
13201 ! & " iatel_e_vdw",iatel_e_vdw
13203 do i=iatel_s_vdw,iatel_e_vdw
13204 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle
13208 dx_normi=dc_norm(1,i)
13209 dy_normi=dc_norm(2,i)
13210 dz_normi=dc_norm(3,i)
13211 xmedi=c(1,i)+0.5d0*dxi
13212 ymedi=c(2,i)+0.5d0*dyi
13213 zmedi=c(3,i)+0.5d0*dzi
13215 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
13216 ! & ' ielend',ielend_vdw(i)
13218 do j=ielstart_vdw(i),ielend_vdw(i)
13219 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
13223 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
13224 aaa=app(iteli,itelj)
13225 bbb=bpp(iteli,itelj)
13229 dx_normj=dc_norm(1,j)
13230 dy_normj=dc_norm(2,j)
13231 dz_normj=dc_norm(3,j)
13232 xj=c(1,j)+0.5D0*dxj-xmedi
13233 yj=c(2,j)+0.5D0*dyj-ymedi
13234 zj=c(3,j)+0.5D0*dzj-zmedi
13235 rij=xj*xj+yj*yj+zj*zj
13238 sss=sscale(rij/rpp(iteli,itelj))
13239 if (sss.gt.0.0d0) then
13244 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
13245 if (j.eq.i+2) ev1=scal_el*ev1
13248 if (energy_dec) then
13249 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
13251 evdw1=evdw1+evdwij*sss
13253 ! Calculate contributions to the Cartesian gradient.
13255 facvdw=-6*rrmij*(ev1+evdwij)*sss
13260 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
13261 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
13267 end subroutine evdwpp_short
13268 !-----------------------------------------------------------------------------
13269 subroutine escp_long(evdw2,evdw2_14)
13271 ! This subroutine calculates the excluded-volume interaction energy between
13272 ! peptide-group centers and side chains and its gradient in virtual-bond and
13273 ! side-chain vectors.
13275 ! implicit real*8 (a-h,o-z)
13276 ! include 'DIMENSIONS'
13277 ! include 'COMMON.GEO'
13278 ! include 'COMMON.VAR'
13279 ! include 'COMMON.LOCAL'
13280 ! include 'COMMON.CHAIN'
13281 ! include 'COMMON.DERIV'
13282 ! include 'COMMON.INTERACT'
13283 ! include 'COMMON.FFIELD'
13284 ! include 'COMMON.IOUNITS'
13285 ! include 'COMMON.CONTROL'
13286 real(kind=8),dimension(3) :: ggg
13287 !el local variables
13288 integer :: i,iint,j,k,iteli,itypj
13289 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2
13290 real(kind=8) :: evdw2,evdw2_14,evdwij
13293 !d print '(a)','Enter ESCP'
13294 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
13295 do i=iatscp_s,iatscp_e
13296 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
13298 xi=0.5D0*(c(1,i)+c(1,i+1))
13299 yi=0.5D0*(c(2,i)+c(2,i+1))
13300 zi=0.5D0*(c(3,i)+c(3,i+1))
13302 do iint=1,nscp_gr(i)
13304 do j=iscpstart(i,iint),iscpend(i,iint)
13306 if (itypj.eq.ntyp1) cycle
13307 ! Uncomment following three lines for SC-p interactions
13308 ! xj=c(1,nres+j)-xi
13309 ! yj=c(2,nres+j)-yi
13310 ! zj=c(3,nres+j)-zi
13311 ! Uncomment following three lines for Ca-p interactions
13315 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13317 sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
13319 if (sss.lt.1.0d0) then
13322 e1=fac*fac*aad(itypj,iteli)
13323 e2=fac*bad(itypj,iteli)
13324 if (iabs(j-i) .le. 2) then
13327 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)
13330 evdw2=evdw2+evdwij*(1.0d0-sss)
13331 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
13332 'evdw2',i,j,sss,evdwij
13334 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
13336 fac=-(evdwij+e1)*rrij*(1.0d0-sss)
13340 ! Uncomment following three lines for SC-p interactions
13342 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
13344 ! Uncomment following line for SC-p interactions
13345 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
13347 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
13348 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
13357 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
13358 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
13359 gradx_scp(j,i)=expon*gradx_scp(j,i)
13362 !******************************************************************************
13366 ! To save time the factor EXPON has been extracted from ALL components
13367 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
13370 !******************************************************************************
13372 end subroutine escp_long
13373 !-----------------------------------------------------------------------------
13374 subroutine escp_short(evdw2,evdw2_14)
13376 ! This subroutine calculates the excluded-volume interaction energy between
13377 ! peptide-group centers and side chains and its gradient in virtual-bond and
13378 ! side-chain vectors.
13380 ! implicit real*8 (a-h,o-z)
13381 ! include 'DIMENSIONS'
13382 ! include 'COMMON.GEO'
13383 ! include 'COMMON.VAR'
13384 ! include 'COMMON.LOCAL'
13385 ! include 'COMMON.CHAIN'
13386 ! include 'COMMON.DERIV'
13387 ! include 'COMMON.INTERACT'
13388 ! include 'COMMON.FFIELD'
13389 ! include 'COMMON.IOUNITS'
13390 ! include 'COMMON.CONTROL'
13391 real(kind=8),dimension(3) :: ggg
13392 !el local variables
13393 integer :: i,iint,j,k,iteli,itypj
13394 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2
13395 real(kind=8) :: evdw2,evdw2_14,evdwij
13398 !d print '(a)','Enter ESCP'
13399 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
13400 do i=iatscp_s,iatscp_e
13401 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
13403 xi=0.5D0*(c(1,i)+c(1,i+1))
13404 yi=0.5D0*(c(2,i)+c(2,i+1))
13405 zi=0.5D0*(c(3,i)+c(3,i+1))
13407 do iint=1,nscp_gr(i)
13409 do j=iscpstart(i,iint),iscpend(i,iint)
13411 if (itypj.eq.ntyp1) cycle
13412 ! Uncomment following three lines for SC-p interactions
13413 ! xj=c(1,nres+j)-xi
13414 ! yj=c(2,nres+j)-yi
13415 ! zj=c(3,nres+j)-zi
13416 ! Uncomment following three lines for Ca-p interactions
13420 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13422 sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
13424 if (sss.gt.0.0d0) then
13427 e1=fac*fac*aad(itypj,iteli)
13428 e2=fac*bad(itypj,iteli)
13429 if (iabs(j-i) .le. 2) then
13432 evdw2_14=evdw2_14+(e1+e2)*sss
13435 evdw2=evdw2+evdwij*sss
13436 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
13437 'evdw2',i,j,sss,evdwij
13439 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
13441 fac=-(evdwij+e1)*rrij*sss
13445 ! Uncomment following three lines for SC-p interactions
13447 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
13449 ! Uncomment following line for SC-p interactions
13450 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
13452 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
13453 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
13462 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
13463 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
13464 gradx_scp(j,i)=expon*gradx_scp(j,i)
13467 !******************************************************************************
13471 ! To save time the factor EXPON has been extracted from ALL components
13472 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
13475 !******************************************************************************
13477 end subroutine escp_short
13478 !-----------------------------------------------------------------------------
13479 ! energy_p_new-sep_barrier.F
13480 !-----------------------------------------------------------------------------
13481 subroutine sc_grad_scale(scalfac)
13482 ! implicit real*8 (a-h,o-z)
13484 ! include 'DIMENSIONS'
13485 ! include 'COMMON.CHAIN'
13486 ! include 'COMMON.DERIV'
13487 ! include 'COMMON.CALC'
13488 ! include 'COMMON.IOUNITS'
13489 real(kind=8),dimension(3) :: dcosom1,dcosom2
13490 real(kind=8) :: scalfac
13491 !el local variables
13492 ! integer :: i,j,k,l
13494 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
13495 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
13496 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
13497 -2.0D0*alf12*eps3der+sigder*sigsq_om12
13501 ! eom12=evdwij*eps1_om12
13503 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
13504 ! & " sigder",sigder
13505 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
13506 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
13508 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
13509 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
13512 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
13515 ! write (iout,*) "gg",(gg(k),k=1,3)
13517 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
13518 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
13519 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
13521 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
13522 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
13523 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
13525 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
13526 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
13527 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
13528 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
13531 ! Calculate the components of the gradient in DC and X
13534 gvdwc(l,i)=gvdwc(l,i)-gg(l)
13535 gvdwc(l,j)=gvdwc(l,j)+gg(l)
13538 end subroutine sc_grad_scale
13539 !-----------------------------------------------------------------------------
13540 ! energy_split-sep.F
13541 !-----------------------------------------------------------------------------
13542 subroutine etotal_long(energia)
13544 ! Compute the long-range slow-varying contributions to the energy
13546 ! implicit real*8 (a-h,o-z)
13547 ! include 'DIMENSIONS'
13548 use MD_data, only: totT,usampl,eq_time
13552 !MS$ATTRIBUTES C :: proc_proc
13557 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
13559 ! include 'COMMON.SETUP'
13560 ! include 'COMMON.IOUNITS'
13561 ! include 'COMMON.FFIELD'
13562 ! include 'COMMON.DERIV'
13563 ! include 'COMMON.INTERACT'
13564 ! include 'COMMON.SBRIDGE'
13565 ! include 'COMMON.CHAIN'
13566 ! include 'COMMON.VAR'
13567 ! include 'COMMON.LOCAL'
13568 ! include 'COMMON.MD'
13569 real(kind=8),dimension(0:n_ene) :: energia
13570 !el local variables
13571 integer :: i,n_corr,n_corr1,ierror,ierr
13572 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
13573 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
13574 ecorr,ecorr5,ecorr6,eturn6,time00
13575 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
13576 !elwrite(iout,*)"in etotal long"
13578 if (modecalc.eq.12.or.modecalc.eq.14) then
13580 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
13582 call int_from_cart1(.false.)
13585 !elwrite(iout,*)"in etotal long"
13588 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
13589 ! & " absolute rank",myrank," nfgtasks",nfgtasks
13591 if (nfgtasks.gt.1) then
13593 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
13594 if (fg_rank.eq.0) then
13595 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
13596 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
13598 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
13599 ! FG slaves as WEIGHTS array.
13606 weights_(7)=wel_loc
13609 weights_(10)=wturn6
13611 weights_(12)=wscloc
13613 weights_(14)=wtor_d
13614 weights_(15)=wstrain
13615 weights_(16)=wvdwpp
13617 weights_(18)=scal14
13618 weights_(21)=wsccor
13619 ! FG Master broadcasts the WEIGHTS_ array
13620 call MPI_Bcast(weights_(1),n_ene,&
13621 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13623 ! FG slaves receive the WEIGHTS array
13624 call MPI_Bcast(weights(1),n_ene,&
13625 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13640 wstrain=weights(15)
13646 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
13648 time_Bcast=time_Bcast+MPI_Wtime()-time00
13649 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
13650 ! call chainbuild_cart
13651 ! call int_from_cart1(.false.)
13653 ! write (iout,*) 'Processor',myrank,
13654 ! & ' calling etotal_short ipot=',ipot
13656 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
13658 !d print *,'nnt=',nnt,' nct=',nct
13660 !elwrite(iout,*)"in etotal long"
13661 ! Compute the side-chain and electrostatic interaction energy
13663 goto (101,102,103,104,105,106) ipot
13664 ! Lennard-Jones potential.
13665 101 call elj_long(evdw)
13666 !d print '(a)','Exit ELJ'
13668 ! Lennard-Jones-Kihara potential (shifted).
13669 102 call eljk_long(evdw)
13671 ! Berne-Pechukas potential (dilated LJ, angular dependence).
13672 103 call ebp_long(evdw)
13674 ! Gay-Berne potential (shifted LJ, angular dependence).
13675 104 call egb_long(evdw)
13677 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
13678 105 call egbv_long(evdw)
13680 ! Soft-sphere potential
13681 106 call e_softsphere(evdw)
13683 ! Calculate electrostatic (H-bonding) energy of the main chain.
13687 if (ipot.lt.6) then
13689 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
13690 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
13691 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
13692 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
13694 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
13695 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
13696 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
13697 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
13699 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13708 ! write (iout,*) "Soft-spheer ELEC potential"
13709 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
13713 ! Calculate excluded-volume interaction energy between peptide groups
13716 if (ipot.lt.6) then
13717 if(wscp.gt.0d0) then
13718 call escp_long(evdw2,evdw2_14)
13724 call escp_soft_sphere(evdw2,evdw2_14)
13727 ! 12/1/95 Multi-body terms
13731 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
13732 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
13733 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
13734 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
13735 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
13742 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
13743 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
13746 ! If performing constraint dynamics, call the constraint energy
13747 ! after the equilibration time
13748 if(usampl.and.totT.gt.eq_time) then
13763 energia(2)=evdw2-evdw2_14
13764 energia(18)=evdw2_14
13773 energia(3)=ees+evdw1
13780 energia(8)=eello_turn3
13781 energia(9)=eello_turn4
13783 energia(20)=Uconst+Uconst_back
13784 call sum_energy(energia,.true.)
13785 ! write (iout,*) "Exit ETOTAL_LONG"
13788 end subroutine etotal_long
13789 !-----------------------------------------------------------------------------
13790 subroutine etotal_short(energia)
13792 ! Compute the short-range fast-varying contributions to the energy
13794 ! implicit real*8 (a-h,o-z)
13795 ! include 'DIMENSIONS'
13799 !MS$ATTRIBUTES C :: proc_proc
13804 integer :: ierror,ierr
13805 real(kind=8),dimension(n_ene) :: weights_
13806 real(kind=8) :: time00
13808 ! include 'COMMON.SETUP'
13809 ! include 'COMMON.IOUNITS'
13810 ! include 'COMMON.FFIELD'
13811 ! include 'COMMON.DERIV'
13812 ! include 'COMMON.INTERACT'
13813 ! include 'COMMON.SBRIDGE'
13814 ! include 'COMMON.CHAIN'
13815 ! include 'COMMON.VAR'
13816 ! include 'COMMON.LOCAL'
13817 real(kind=8),dimension(0:n_ene) :: energia
13818 !el local variables
13820 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
13821 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr
13824 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
13826 if (modecalc.eq.12.or.modecalc.eq.14) then
13828 if (fg_rank.eq.0) call int_from_cart1(.false.)
13830 call int_from_cart1(.false.)
13834 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
13835 ! & " absolute rank",myrank," nfgtasks",nfgtasks
13837 if (nfgtasks.gt.1) then
13839 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
13840 if (fg_rank.eq.0) then
13841 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
13842 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
13844 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
13845 ! FG slaves as WEIGHTS array.
13852 weights_(7)=wel_loc
13855 weights_(10)=wturn6
13857 weights_(12)=wscloc
13859 weights_(14)=wtor_d
13860 weights_(15)=wstrain
13861 weights_(16)=wvdwpp
13863 weights_(18)=scal14
13864 weights_(21)=wsccor
13865 ! FG Master broadcasts the WEIGHTS_ array
13866 call MPI_Bcast(weights_(1),n_ene,&
13867 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13869 ! FG slaves receive the WEIGHTS array
13870 call MPI_Bcast(weights(1),n_ene,&
13871 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13886 wstrain=weights(15)
13892 ! write (iout,*),"Processor",myrank," BROADCAST weights"
13893 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
13895 ! write (iout,*) "Processor",myrank," BROADCAST c"
13896 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
13898 ! write (iout,*) "Processor",myrank," BROADCAST dc"
13899 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
13901 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
13902 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
13904 ! write (iout,*) "Processor",myrank," BROADCAST theta"
13905 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
13907 ! write (iout,*) "Processor",myrank," BROADCAST phi"
13908 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
13910 ! write (iout,*) "Processor",myrank," BROADCAST alph"
13911 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
13913 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
13914 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
13916 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
13917 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
13919 time_Bcast=time_Bcast+MPI_Wtime()-time00
13920 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
13922 ! write (iout,*) 'Processor',myrank,
13923 ! & ' calling etotal_short ipot=',ipot
13925 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
13927 ! call int_from_cart1(.false.)
13929 ! Compute the side-chain and electrostatic interaction energy
13931 goto (101,102,103,104,105,106) ipot
13932 ! Lennard-Jones potential.
13933 101 call elj_short(evdw)
13934 !d print '(a)','Exit ELJ'
13936 ! Lennard-Jones-Kihara potential (shifted).
13937 102 call eljk_short(evdw)
13939 ! Berne-Pechukas potential (dilated LJ, angular dependence).
13940 103 call ebp_short(evdw)
13942 ! Gay-Berne potential (shifted LJ, angular dependence).
13943 104 call egb_short(evdw)
13945 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
13946 105 call egbv_short(evdw)
13948 ! Soft-sphere potential - already dealt with in the long-range part
13950 ! 106 call e_softsphere_short(evdw)
13952 ! Calculate electrostatic (H-bonding) energy of the main chain.
13956 ! Calculate the short-range part of Evdwpp
13958 call evdwpp_short(evdw1)
13960 ! Calculate the short-range part of ESCp
13962 if (ipot.lt.6) then
13963 call escp_short(evdw2,evdw2_14)
13966 ! Calculate the bond-stretching energy
13970 ! Calculate the disulfide-bridge and other energy and the contributions
13971 ! from other distance constraints.
13974 ! Calculate the virtual-bond-angle energy.
13978 ! Calculate the SC local energy.
13983 ! Calculate the virtual-bond torsional energy.
13985 call etor(etors,edihcnstr)
13987 ! 6/23/01 Calculate double-torsional energy
13989 call etor_d(etors_d)
13991 ! 21/5/07 Calculate local sicdechain correlation energy
13993 if (wsccor.gt.0.0d0) then
13994 call eback_sc_corr(esccor)
13999 ! Put energy components into an array
14006 energia(2)=evdw2-evdw2_14
14007 energia(18)=evdw2_14
14020 energia(14)=etors_d
14023 energia(19)=edihcnstr
14025 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
14027 call sum_energy(energia,.true.)
14028 ! write (iout,*) "Exit ETOTAL_SHORT"
14031 end subroutine etotal_short
14032 !-----------------------------------------------------------------------------
14034 !-----------------------------------------------------------------------------
14035 real(kind=8) function gnmr1(y,ymin,ymax)
14037 real(kind=8) :: y,ymin,ymax
14038 real(kind=8) :: wykl=4.0d0
14039 if (y.lt.ymin) then
14040 gnmr1=(ymin-y)**wykl/wykl
14041 else if (y.gt.ymax) then
14042 gnmr1=(y-ymax)**wykl/wykl
14048 !-----------------------------------------------------------------------------
14049 real(kind=8) function gnmr1prim(y,ymin,ymax)
14051 real(kind=8) :: y,ymin,ymax
14052 real(kind=8) :: wykl=4.0d0
14053 if (y.lt.ymin) then
14054 gnmr1prim=-(ymin-y)**(wykl-1)
14055 else if (y.gt.ymax) then
14056 gnmr1prim=(y-ymax)**(wykl-1)
14061 end function gnmr1prim
14062 !-----------------------------------------------------------------------------
14063 real(kind=8) function harmonic(y,ymax)
14065 real(kind=8) :: y,ymax
14066 real(kind=8) :: wykl=2.0d0
14067 harmonic=(y-ymax)**wykl
14069 end function harmonic
14070 !-----------------------------------------------------------------------------
14071 real(kind=8) function harmonicprim(y,ymax)
14072 real(kind=8) :: y,ymin,ymax
14073 real(kind=8) :: wykl=2.0d0
14074 harmonicprim=(y-ymax)*wykl
14076 end function harmonicprim
14077 !-----------------------------------------------------------------------------
14079 !-----------------------------------------------------------------------------
14080 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
14082 use io_base, only:intout,briefout
14083 ! implicit real*8 (a-h,o-z)
14084 ! include 'DIMENSIONS'
14085 ! include 'COMMON.CHAIN'
14086 ! include 'COMMON.DERIV'
14087 ! include 'COMMON.VAR'
14088 ! include 'COMMON.INTERACT'
14089 ! include 'COMMON.FFIELD'
14090 ! include 'COMMON.MD'
14091 ! include 'COMMON.IOUNITS'
14092 real(kind=8),external :: ufparm
14093 integer :: uiparm(1)
14094 real(kind=8) :: urparm(1)
14095 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
14096 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
14097 integer :: n,nf,ind,ind1,i,k,j
14099 ! This subroutine calculates total internal coordinate gradient.
14100 ! Depending on the number of function evaluations, either whole energy
14101 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
14102 ! internal coordinates are reevaluated or only the cartesian-in-internal
14103 ! coordinate derivatives are evaluated. The subroutine was designed to work
14109 !d print *,'grad',nf,icg
14110 if (nf-nfl+1) 20,30,40
14111 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
14112 ! write (iout,*) 'grad 20'
14113 if (nf.eq.0) return
14115 30 call var_to_geom(n,x)
14117 ! write (iout,*) 'grad 30'
14119 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
14122 ! write (iout,*) 'grad 40'
14123 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
14125 ! Convert the Cartesian gradient into internal-coordinate gradient.
14135 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
14137 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
14140 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
14146 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
14148 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
14149 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
14152 if (i.gt.1) g(i-1)=gphii
14153 if (n.gt.nphi) g(nphi+i)=gthetai
14155 if (n.le.nphi+ntheta) goto 10
14157 if (itype(i).ne.10) then
14161 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
14164 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
14166 g(ialph(i,1))=galphai
14167 g(ialph(i,1)+nside)=gomegai
14171 ! Add the components corresponding to local energy terms.
14175 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
14176 g(i)=g(i)+gloc(i,icg)
14178 ! Uncomment following three lines for diagnostics.
14180 !elwrite(iout,*) "in gradient after calling intout"
14181 !d call briefout(0,0.0d0)
14182 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
14184 end subroutine gradient
14185 !-----------------------------------------------------------------------------
14186 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
14189 ! implicit real*8 (a-h,o-z)
14190 ! include 'DIMENSIONS'
14191 ! include 'COMMON.DERIV'
14192 ! include 'COMMON.IOUNITS'
14193 ! include 'COMMON.GEO'
14196 !el common /chuju/ jjj
14197 real(kind=8) :: energia(0:n_ene)
14198 integer :: uiparm(1)
14199 real(kind=8) :: urparm(1)
14201 real(kind=8),external :: ufparm
14202 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
14203 ! if (jjj.gt.0) then
14204 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
14208 !d print *,'func',nf,nfl,icg
14209 call var_to_geom(n,x)
14212 !d write (iout,*) 'ETOTAL called from FUNC'
14213 call etotal(energia)
14216 ! if (jjj.gt.0) then
14217 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
14218 ! write (iout,*) 'f=',etot
14222 end subroutine func
14223 !-----------------------------------------------------------------------------
14224 subroutine cartgrad
14225 ! implicit real*8 (a-h,o-z)
14226 ! include 'DIMENSIONS'
14228 use MD_data, only: totT,usampl,eq_time
14232 ! include 'COMMON.CHAIN'
14233 ! include 'COMMON.DERIV'
14234 ! include 'COMMON.VAR'
14235 ! include 'COMMON.INTERACT'
14236 ! include 'COMMON.FFIELD'
14237 ! include 'COMMON.MD'
14238 ! include 'COMMON.IOUNITS'
14239 ! include 'COMMON.TIME1'
14243 ! This subrouting calculates total Cartesian coordinate gradient.
14244 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
14254 !el write (iout,*) "After sum_gradient"
14256 !el write (iout,*) "After sum_gradient"
14258 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
14259 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
14262 ! If performing constraint dynamics, add the gradients of the constraint energy
14263 if(usampl.and.totT.gt.eq_time) then
14266 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
14267 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
14271 gloc(i,icg)=gloc(i,icg)+dugamma(i)
14274 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
14277 !elwrite (iout,*) "After sum_gradient"
14282 !elwrite (iout,*) "After sum_gradient"
14284 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
14286 ! call checkintcartgrad
14287 ! write(iout,*) 'calling int_to_cart'
14289 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
14293 gcart(j,i)=gradc(j,i,icg)
14294 gxcart(j,i)=gradx(j,i,icg)
14297 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
14298 (gxcart(j,i),j=1,3),gloc(i,icg)
14306 time_inttocart=time_inttocart+MPI_Wtime()-time01
14309 write (iout,*) "gcart and gxcart after int_to_cart"
14311 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
14312 (gxcart(j,i),j=1,3)
14317 write (iout,*) "CARGRAD"
14321 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
14322 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
14324 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
14325 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
14327 ! Correction: dummy residues
14330 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
14331 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
14334 if (nct.lt.nres) then
14336 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
14337 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
14342 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
14346 end subroutine cartgrad
14347 !-----------------------------------------------------------------------------
14348 subroutine zerograd
14349 ! implicit real*8 (a-h,o-z)
14350 ! include 'DIMENSIONS'
14351 ! include 'COMMON.DERIV'
14352 ! include 'COMMON.CHAIN'
14353 ! include 'COMMON.VAR'
14354 ! include 'COMMON.MD'
14355 ! include 'COMMON.SCCOR'
14357 !el local variables
14358 integer :: i,j,intertyp
14359 ! Initialize Cartesian-coordinate gradient
14361 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
14362 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
14364 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
14365 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
14366 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
14367 ! allocate(gradcorr_long(3,nres))
14368 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
14369 ! allocate(gcorr6_turn_long(3,nres))
14370 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
14372 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
14374 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
14375 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
14377 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
14378 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
14380 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
14381 ! allocate(gscloc(3,nres)) !(3,maxres)
14382 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
14386 ! common /deriv_scloc/
14387 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
14388 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
14389 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
14391 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
14395 ! gradc(j,i,icg)=0.0d0
14396 ! gradx(j,i,icg)=0.0d0
14398 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
14399 !elwrite(iout,*) "icg",icg
14403 gradx_scp(j,i)=0.0D0
14405 gvdwc_scp(j,i)=0.0D0
14406 gvdwc_scpp(j,i)=0.0d0
14408 gelc_long(j,i)=0.0D0
14413 gel_loc_long(j,i)=0.0d0
14416 gcorr3_turn(j,i)=0.0d0
14417 gcorr4_turn(j,i)=0.0d0
14418 gradcorr(j,i)=0.0d0
14419 gradcorr_long(j,i)=0.0d0
14420 gradcorr5_long(j,i)=0.0d0
14421 gradcorr6_long(j,i)=0.0d0
14422 gcorr6_turn_long(j,i)=0.0d0
14423 gradcorr5(j,i)=0.0d0
14424 gradcorr6(j,i)=0.0d0
14425 gcorr6_turn(j,i)=0.0d0
14428 gradc(j,i,icg)=0.0d0
14429 gradx(j,i,icg)=0.0d0
14433 gloc_sc(intertyp,i,icg)=0.0d0
14438 ! Initialize the gradient of local energy terms.
14440 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
14441 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
14442 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
14443 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
14444 ! allocate(gel_loc_turn3(nres))
14445 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
14446 ! allocate(gsccor_loc(nres)) !(maxres)
14452 gel_loc_loc(i)=0.0d0
14454 g_corr5_loc(i)=0.0d0
14455 g_corr6_loc(i)=0.0d0
14456 gel_loc_turn3(i)=0.0d0
14457 gel_loc_turn4(i)=0.0d0
14458 gel_loc_turn6(i)=0.0d0
14459 gsccor_loc(i)=0.0d0
14461 ! initialize gcart and gxcart
14462 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
14470 end subroutine zerograd
14471 !-----------------------------------------------------------------------------
14472 real(kind=8) function fdum()
14476 !-----------------------------------------------------------------------------
14478 !-----------------------------------------------------------------------------
14479 subroutine intcartderiv
14480 ! implicit real*8 (a-h,o-z)
14481 ! include 'DIMENSIONS'
14485 ! include 'COMMON.SETUP'
14486 ! include 'COMMON.CHAIN'
14487 ! include 'COMMON.VAR'
14488 ! include 'COMMON.GEO'
14489 ! include 'COMMON.INTERACT'
14490 ! include 'COMMON.DERIV'
14491 ! include 'COMMON.IOUNITS'
14492 ! include 'COMMON.LOCAL'
14493 ! include 'COMMON.SCCOR'
14494 real(kind=8) :: pi4,pi34
14495 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
14496 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
14497 dcosomega,dsinomega !(3,3,maxres)
14498 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
14501 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
14502 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
14503 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
14504 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
14508 !el from module energy-------------
14509 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
14510 !el allocate(dsintau(3,3,3,itau_start:itau_end))
14511 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
14513 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
14514 !el allocate(dsintau(3,3,3,0:nres2))
14515 !el allocate(dtauangle(3,3,3,0:nres2))
14516 !el allocate(domicron(3,2,2,0:nres2))
14517 !el allocate(dcosomicron(3,2,2,0:nres2))
14521 #if defined(MPI) && defined(PARINTDER)
14522 if (nfgtasks.gt.1 .and. me.eq.king) &
14523 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
14528 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
14529 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
14531 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
14534 dtheta(j,1,i)=0.0d0
14535 dtheta(j,2,i)=0.0d0
14541 ! Derivatives of theta's
14542 #if defined(MPI) && defined(PARINTDER)
14543 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
14544 do i=max0(ithet_start-1,3),ithet_end
14548 cost=dcos(theta(i))
14549 sint=sqrt(1-cost*cost)
14551 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
14553 if (itype(i-1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
14554 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
14556 if (itype(i-1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
14559 #if defined(MPI) && defined(PARINTDER)
14560 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
14561 do i=max0(ithet_start-1,3),ithet_end
14565 if ((itype(i-1).ne.10).and.(itype(i-1).ne.ntyp1)) then
14566 cost1=dcos(omicron(1,i))
14567 sint1=sqrt(1-cost1*cost1)
14568 cost2=dcos(omicron(2,i))
14569 sint2=sqrt(1-cost2*cost2)
14571 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
14572 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
14573 cost1*dc_norm(j,i-2))/ &
14575 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
14576 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
14577 +cost1*(dc_norm(j,i-1+nres)))/ &
14579 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
14580 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
14581 !C Looks messy but better than if in loop
14582 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
14583 +cost2*dc_norm(j,i-1))/ &
14585 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
14586 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
14587 +cost2*(-dc_norm(j,i-1+nres)))/ &
14589 ! write(iout,*) "vbld", i,itype(i),vbld(i-1+nres)
14590 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
14594 !elwrite(iout,*) "after vbld write"
14595 ! Derivatives of phi:
14596 ! If phi is 0 or 180 degrees, then the formulas
14597 ! have to be derived by power series expansion of the
14598 ! conventional formulas around 0 and 180.
14600 do i=iphi1_start,iphi1_end
14604 ! if (itype(i-1).eq.21 .or. itype(i-2).eq.21 ) cycle
14605 ! the conventional case
14606 sint=dsin(theta(i))
14607 sint1=dsin(theta(i-1))
14609 cost=dcos(theta(i))
14610 cost1=dcos(theta(i-1))
14612 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
14613 fac0=1.0d0/(sint1*sint)
14616 fac3=cosg*cost1/(sint1*sint1)
14617 fac4=cosg*cost/(sint*sint)
14618 ! Obtaining the gamma derivatives from sine derivative
14619 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
14620 phi(i).gt.pi34.and.phi(i).le.pi.or. &
14621 phi(i).gt.-pi.and.phi(i).le.-pi34) then
14622 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
14623 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
14624 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
14628 cosg_inv=1.0d0/cosg
14629 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
14630 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
14631 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
14632 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
14634 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
14635 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14636 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
14637 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
14638 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
14639 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14640 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
14642 ! Bug fixed 3/24/05 (AL)
14644 ! Obtaining the gamma derivatives from cosine derivative
14647 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
14648 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
14649 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
14650 dc_norm(j,i-3))/vbld(i-2)
14651 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
14652 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
14653 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
14655 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
14656 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
14657 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
14658 dc_norm(j,i-1))/vbld(i)
14659 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
14664 !alculate derivative of Tauangle
14666 do i=itau_start,itau_end
14669 !elwrite(iout,*) " vecpr",i,nres
14671 if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
14672 ! if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10).or.
14673 ! & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1)) cycle
14674 !c dtauangle(j,intertyp,dervityp,residue number)
14675 !c INTERTYP=1 SC...Ca...Ca..Ca
14676 ! the conventional case
14677 sint=dsin(theta(i))
14678 sint1=dsin(omicron(2,i-1))
14679 sing=dsin(tauangle(1,i))
14680 cost=dcos(theta(i))
14681 cost1=dcos(omicron(2,i-1))
14682 cosg=dcos(tauangle(1,i))
14683 !elwrite(iout,*) " vecpr5",i,nres
14685 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
14686 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
14687 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
14688 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
14690 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
14691 fac0=1.0d0/(sint1*sint)
14694 fac3=cosg*cost1/(sint1*sint1)
14695 fac4=cosg*cost/(sint*sint)
14696 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
14697 ! Obtaining the gamma derivatives from sine derivative
14698 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
14699 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
14700 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
14701 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
14702 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
14703 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
14707 cosg_inv=1.0d0/cosg
14708 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
14709 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
14710 *vbld_inv(i-2+nres)
14711 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
14712 dsintau(j,1,2,i)= &
14713 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
14714 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14715 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
14716 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
14717 ! Bug fixed 3/24/05 (AL)
14718 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
14719 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
14720 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14721 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
14723 ! Obtaining the gamma derivatives from cosine derivative
14726 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
14727 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
14728 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
14729 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
14730 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
14731 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
14733 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
14734 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
14735 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
14736 dc_norm(j,i-1))/vbld(i)
14737 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
14738 ! write (iout,*) "else",i
14742 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
14745 !C Second case Ca...Ca...Ca...SC
14747 do i=itau_start,itau_end
14751 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
14752 (itype(i-2).eq.ntyp1).or.(itype(i-3).eq.ntyp1)) cycle
14753 ! the conventional case
14754 sint=dsin(omicron(1,i))
14755 sint1=dsin(theta(i-1))
14756 sing=dsin(tauangle(2,i))
14757 cost=dcos(omicron(1,i))
14758 cost1=dcos(theta(i-1))
14759 cosg=dcos(tauangle(2,i))
14761 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
14763 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
14764 fac0=1.0d0/(sint1*sint)
14767 fac3=cosg*cost1/(sint1*sint1)
14768 fac4=cosg*cost/(sint*sint)
14769 ! Obtaining the gamma derivatives from sine derivative
14770 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
14771 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
14772 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
14773 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
14774 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
14775 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
14779 cosg_inv=1.0d0/cosg
14780 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
14781 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
14782 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
14783 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
14784 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
14785 dsintau(j,2,2,i)= &
14786 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
14787 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14788 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
14789 ! & sing*ctgt*domicron(j,1,2,i),
14790 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14791 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
14792 ! Bug fixed 3/24/05 (AL)
14793 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
14794 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
14795 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14796 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
14798 ! Obtaining the gamma derivatives from cosine derivative
14801 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
14802 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
14803 dc_norm(j,i-3))/vbld(i-2)
14804 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
14805 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
14806 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
14807 dcosomicron(j,1,1,i)
14808 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
14809 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
14810 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
14811 dc_norm(j,i-1+nres))/vbld(i-1+nres)
14812 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
14813 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
14818 !CC third case SC...Ca...Ca...SC
14821 do i=itau_start,itau_end
14825 ! the conventional case
14826 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
14827 (itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
14828 sint=dsin(omicron(1,i))
14829 sint1=dsin(omicron(2,i-1))
14830 sing=dsin(tauangle(3,i))
14831 cost=dcos(omicron(1,i))
14832 cost1=dcos(omicron(2,i-1))
14833 cosg=dcos(tauangle(3,i))
14835 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
14836 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
14838 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
14839 fac0=1.0d0/(sint1*sint)
14842 fac3=cosg*cost1/(sint1*sint1)
14843 fac4=cosg*cost/(sint*sint)
14844 ! Obtaining the gamma derivatives from sine derivative
14845 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
14846 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
14847 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
14848 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
14849 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
14850 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
14854 cosg_inv=1.0d0/cosg
14855 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
14856 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
14857 *vbld_inv(i-2+nres)
14858 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
14859 dsintau(j,3,2,i)= &
14860 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
14861 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14862 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
14863 ! Bug fixed 3/24/05 (AL)
14864 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
14865 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
14866 *vbld_inv(i-1+nres)
14867 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14868 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
14870 ! Obtaining the gamma derivatives from cosine derivative
14873 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
14874 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
14875 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
14876 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
14877 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
14878 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
14879 dcosomicron(j,1,1,i)
14880 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
14881 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
14882 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
14883 dc_norm(j,i-1+nres))/vbld(i-1+nres)
14884 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
14885 ! write(iout,*) "else",i
14891 ! Derivatives of side-chain angles alpha and omega
14892 #if defined(MPI) && defined(PARINTDER)
14893 do i=ibond_start,ibond_end
14897 if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then
14898 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
14901 fac8=fac5/vbld(i+1)
14902 fac9=fac5/vbld(i+nres)
14903 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
14904 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
14905 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
14906 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
14907 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
14908 sina=sqrt(1-cosa*cosa)
14910 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
14912 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
14913 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
14914 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
14915 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
14916 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
14917 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
14918 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
14919 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
14921 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
14923 ! obtaining the derivatives of omega from sines
14924 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
14925 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
14926 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
14927 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
14929 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
14930 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
14931 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
14932 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
14933 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
14934 coso_inv=1.0d0/dcos(omeg(i))
14936 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
14937 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
14938 (sino*dc_norm(j,i-1))/vbld(i)
14939 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
14940 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
14941 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
14942 -sino*dc_norm(j,i)/vbld(i+1)
14943 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
14944 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
14945 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
14947 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
14950 ! obtaining the derivatives of omega from cosines
14951 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
14952 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
14957 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
14958 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
14959 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
14960 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
14961 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
14962 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
14963 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
14964 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
14965 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
14966 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
14967 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
14968 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
14969 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
14970 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
14971 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
14977 dalpha(k,j,i)=0.0d0
14978 domega(k,j,i)=0.0d0
14984 #if defined(MPI) && defined(PARINTDER)
14985 if (nfgtasks.gt.1) then
14987 !d write (iout,*) "Gather dtheta"
14988 !d call flush(iout)
14989 write (iout,*) "dtheta before gather"
14991 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
14994 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
14995 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
14996 king,FG_COMM,IERROR)
14998 !d write (iout,*) "Gather dphi"
14999 !d call flush(iout)
15000 write (iout,*) "dphi before gather"
15002 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
15005 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
15006 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
15007 king,FG_COMM,IERROR)
15008 !d write (iout,*) "Gather dalpha"
15009 !d call flush(iout)
15011 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
15012 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
15013 king,FG_COMM,IERROR)
15014 !d write (iout,*) "Gather domega"
15015 !d call flush(iout)
15016 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
15017 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
15018 king,FG_COMM,IERROR)
15023 write (iout,*) "dtheta after gather"
15025 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
15027 write (iout,*) "dphi after gather"
15029 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
15031 write (iout,*) "dalpha after gather"
15033 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
15035 write (iout,*) "domega after gather"
15037 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
15041 end subroutine intcartderiv
15042 !-----------------------------------------------------------------------------
15043 subroutine checkintcartgrad
15044 ! implicit real*8 (a-h,o-z)
15045 ! include 'DIMENSIONS'
15049 ! include 'COMMON.CHAIN'
15050 ! include 'COMMON.VAR'
15051 ! include 'COMMON.GEO'
15052 ! include 'COMMON.INTERACT'
15053 ! include 'COMMON.DERIV'
15054 ! include 'COMMON.IOUNITS'
15055 ! include 'COMMON.SETUP'
15056 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
15057 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
15058 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
15059 real(kind=8),dimension(3) :: dc_norm_s
15060 real(kind=8) :: aincr=1.0d-5
15062 real(kind=8) :: dcji
15065 theta_s(i)=theta(i)
15069 ! Check theta gradient
15071 "Analytical (upper) and numerical (lower) gradient of theta"
15076 dc(j,i-2)=dcji+aincr
15077 call chainbuild_cart
15078 call int_from_cart1(.false.)
15079 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
15082 dc(j,i-1)=dc(j,i-1)+aincr
15083 call chainbuild_cart
15084 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
15087 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
15088 !el (dtheta(j,2,i),j=1,3)
15089 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
15090 !el (dthetanum(j,2,i),j=1,3)
15091 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
15092 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
15093 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
15096 ! Check gamma gradient
15098 "Analytical (upper) and numerical (lower) gradient of gamma"
15102 dc(j,i-3)=dcji+aincr
15103 call chainbuild_cart
15104 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
15107 dc(j,i-2)=dcji+aincr
15108 call chainbuild_cart
15109 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
15112 dc(j,i-1)=dc(j,i-1)+aincr
15113 call chainbuild_cart
15114 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
15117 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
15118 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
15119 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
15120 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
15121 !el write (iout,'(5x,3(3f10.5,5x))') &
15122 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
15123 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
15124 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
15127 ! Check alpha gradient
15129 "Analytical (upper) and numerical (lower) gradient of alpha"
15131 if(itype(i).ne.10) then
15134 dc(j,i-1)=dcji+aincr
15135 call chainbuild_cart
15136 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
15141 call chainbuild_cart
15142 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
15146 dc(j,i+nres)=dc(j,i+nres)+aincr
15147 call chainbuild_cart
15148 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
15153 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
15154 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
15155 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
15156 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
15157 !el write (iout,'(5x,3(3f10.5,5x))') &
15158 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
15159 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
15160 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
15163 ! Check omega gradient
15165 "Analytical (upper) and numerical (lower) gradient of omega"
15167 if(itype(i).ne.10) then
15170 dc(j,i-1)=dcji+aincr
15171 call chainbuild_cart
15172 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
15177 call chainbuild_cart
15178 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
15182 dc(j,i+nres)=dc(j,i+nres)+aincr
15183 call chainbuild_cart
15184 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
15189 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
15190 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
15191 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
15192 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
15193 !el write (iout,'(5x,3(3f10.5,5x))') &
15194 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
15195 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
15196 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
15200 end subroutine checkintcartgrad
15201 !-----------------------------------------------------------------------------
15203 !-----------------------------------------------------------------------------
15204 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
15205 ! implicit real*8 (a-h,o-z)
15206 ! include 'DIMENSIONS'
15207 ! include 'COMMON.IOUNITS'
15208 ! include 'COMMON.CHAIN'
15209 ! include 'COMMON.INTERACT'
15210 ! include 'COMMON.VAR'
15211 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
15212 integer :: kkk,nsep=3
15213 real(kind=8) :: qm !dist,
15214 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
15215 logical :: lprn=.false.
15217 ! real(kind=8) :: sigm,x
15219 !el sigm(x)=0.25d0*x ! local function
15225 do il=seg1+nsep,seg2
15228 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
15229 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
15230 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
15232 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
15233 if (itype(il).ne.10 .or. itype(jl).ne.10) then
15236 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
15237 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
15238 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
15239 dijCM=dist(il+nres,jl+nres)
15240 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
15242 qq = qq+qqij+qqijCM
15248 if((seg3-il).lt.3) then
15255 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
15256 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
15257 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
15259 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
15260 if (itype(il).ne.10 .or. itype(jl).ne.10) then
15263 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
15264 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
15265 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
15266 dijCM=dist(il+nres,jl+nres)
15267 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
15269 qq = qq+qqij+qqijCM
15274 if (qqmax.le.qq) qqmax=qq
15276 qwolynes=1.0d0-qqmax
15278 end function qwolynes
15279 !-----------------------------------------------------------------------------
15280 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
15281 ! implicit real*8 (a-h,o-z)
15282 ! include 'DIMENSIONS'
15283 ! include 'COMMON.IOUNITS'
15284 ! include 'COMMON.CHAIN'
15285 ! include 'COMMON.INTERACT'
15286 ! include 'COMMON.VAR'
15287 ! include 'COMMON.MD'
15288 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
15289 integer :: nsep=3, kkk
15290 !el real(kind=8) :: dist
15291 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
15292 logical :: lprn=.false.
15294 real(kind=8) :: sim,dd0,fac,ddqij
15295 !el sigm(x)=0.25d0*x ! local function
15305 do il=seg1+nsep,seg2
15308 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
15309 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
15310 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
15312 sim = 1.0d0/sigm(d0ij)
15315 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
15317 ddqij = (c(k,il)-c(k,jl))*fac
15318 dqwol(k,il)=dqwol(k,il)+ddqij
15319 dqwol(k,jl)=dqwol(k,jl)-ddqij
15322 if (itype(il).ne.10 .or. itype(jl).ne.10) then
15325 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
15326 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
15327 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
15328 dijCM=dist(il+nres,jl+nres)
15329 sim = 1.0d0/sigm(d0ijCM)
15332 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
15334 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
15335 dxqwol(k,il)=dxqwol(k,il)+ddqij
15336 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
15343 if((seg3-il).lt.3) then
15350 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
15351 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
15352 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
15354 sim = 1.0d0/sigm(d0ij)
15357 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
15359 ddqij = (c(k,il)-c(k,jl))*fac
15360 dqwol(k,il)=dqwol(k,il)+ddqij
15361 dqwol(k,jl)=dqwol(k,jl)-ddqij
15363 if (itype(il).ne.10 .or. itype(jl).ne.10) then
15366 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
15367 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
15368 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
15369 dijCM=dist(il+nres,jl+nres)
15370 sim = 1.0d0/sigm(d0ijCM)
15373 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
15375 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
15376 dxqwol(k,il)=dxqwol(k,il)+ddqij
15377 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
15386 dqwol(j,i)=dqwol(j,i)/nl
15387 dxqwol(j,i)=dxqwol(j,i)/nl
15391 end subroutine qwolynes_prim
15392 !-----------------------------------------------------------------------------
15393 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
15394 ! implicit real*8 (a-h,o-z)
15395 ! include 'DIMENSIONS'
15396 ! include 'COMMON.IOUNITS'
15397 ! include 'COMMON.CHAIN'
15398 ! include 'COMMON.INTERACT'
15399 ! include 'COMMON.VAR'
15400 integer :: seg1,seg2,seg3,seg4
15402 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
15403 real(kind=8),dimension(3,0:2*nres) :: cdummy
15404 real(kind=8) :: q1,q2
15405 real(kind=8) :: delta=1.0d-10
15410 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
15412 c(j,i)=c(j,i)+delta
15413 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
15414 qwolan(j,i)=(q2-q1)/delta
15420 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
15421 cdummy(j,i+nres)=c(j,i+nres)
15422 c(j,i+nres)=c(j,i+nres)+delta
15423 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
15424 qwolxan(j,i)=(q2-q1)/delta
15425 c(j,i+nres)=cdummy(j,i+nres)
15428 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
15430 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
15432 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
15434 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
15437 end subroutine qwol_num
15438 !-----------------------------------------------------------------------------
15439 subroutine EconstrQ
15440 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
15441 ! implicit real*8 (a-h,o-z)
15442 ! include 'DIMENSIONS'
15443 ! include 'COMMON.CONTROL'
15444 ! include 'COMMON.VAR'
15445 ! include 'COMMON.MD'
15448 ! include 'COMMON.LANGEVIN'
15450 ! include 'COMMON.LANGEVIN.lang0'
15452 ! include 'COMMON.CHAIN'
15453 ! include 'COMMON.DERIV'
15454 ! include 'COMMON.GEO'
15455 ! include 'COMMON.LOCAL'
15456 ! include 'COMMON.INTERACT'
15457 ! include 'COMMON.IOUNITS'
15458 ! include 'COMMON.NAMES'
15459 ! include 'COMMON.TIME1'
15460 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
15461 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
15463 integer :: kstart,kend,lstart,lend,idummy
15464 real(kind=8) :: delta=1.0d-7
15465 integer :: i,j,k,ii
15469 dudconst(j,i)=0.0d0
15470 duxconst(j,i)=0.0d0
15471 dudxconst(j,i)=0.0d0
15476 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
15478 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
15479 ! Calculating the derivatives of Constraint energy with respect to Q
15480 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
15482 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
15483 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
15484 ! hmnum=(hm2-hm1)/delta
15485 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
15486 ! & qinfrag(i,iset))
15487 ! write(iout,*) "harmonicnum frag", hmnum
15488 ! Calculating the derivatives of Q with respect to cartesian coordinates
15489 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
15491 ! write(iout,*) "dqwol "
15493 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
15495 ! write(iout,*) "dxqwol "
15497 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
15499 ! Calculating numerical gradients of dU/dQi and dQi/dxi
15500 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
15501 ! & ,idummy,idummy)
15502 ! The gradients of Uconst in Cs
15505 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
15506 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
15511 kstart=ifrag(1,ipair(1,i,iset),iset)
15512 kend=ifrag(2,ipair(1,i,iset),iset)
15513 lstart=ifrag(1,ipair(2,i,iset),iset)
15514 lend=ifrag(2,ipair(2,i,iset),iset)
15515 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
15516 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
15517 ! Calculating dU/dQ
15518 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
15519 ! hm1=harmonic(qpair(i),qinpair(i,iset))
15520 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
15521 ! hmnum=(hm2-hm1)/delta
15522 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
15523 ! & qinpair(i,iset))
15524 ! write(iout,*) "harmonicnum pair ", hmnum
15525 ! Calculating dQ/dXi
15526 call qwolynes_prim(kstart,kend,.false.,&
15528 ! write(iout,*) "dqwol "
15530 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
15532 ! write(iout,*) "dxqwol "
15534 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
15536 ! Calculating numerical gradients
15537 ! call qwol_num(kstart,kend,.false.
15539 ! The gradients of Uconst in Cs
15542 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
15543 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
15547 ! write(iout,*) "Uconst inside subroutine ", Uconst
15548 ! Transforming the gradients from Cs to dCs for the backbone
15552 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
15556 ! Transforming the gradients from Cs to dCs for the side chains
15559 dudxconst(j,i)=duxconst(j,i)
15562 ! write(iout,*) "dU/ddc backbone "
15564 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
15566 ! write(iout,*) "dU/ddX side chain "
15568 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
15570 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
15571 ! call dEconstrQ_num
15573 end subroutine EconstrQ
15574 !-----------------------------------------------------------------------------
15575 subroutine dEconstrQ_num
15576 ! Calculating numerical dUconst/ddc and dUconst/ddx
15577 ! implicit real*8 (a-h,o-z)
15578 ! include 'DIMENSIONS'
15579 ! include 'COMMON.CONTROL'
15580 ! include 'COMMON.VAR'
15581 ! include 'COMMON.MD'
15584 ! include 'COMMON.LANGEVIN'
15586 ! include 'COMMON.LANGEVIN.lang0'
15588 ! include 'COMMON.CHAIN'
15589 ! include 'COMMON.DERIV'
15590 ! include 'COMMON.GEO'
15591 ! include 'COMMON.LOCAL'
15592 ! include 'COMMON.INTERACT'
15593 ! include 'COMMON.IOUNITS'
15594 ! include 'COMMON.NAMES'
15595 ! include 'COMMON.TIME1'
15596 real(kind=8) :: uzap1,uzap2
15597 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
15598 integer :: kstart,kend,lstart,lend,idummy
15599 real(kind=8) :: delta=1.0d-7
15600 !el local variables
15606 dUcartan(j,i)=0.0d0
15607 cdummy(j,i)=dc(j,i)
15608 dc(j,i)=dc(j,i)+delta
15609 call chainbuild_cart
15612 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15614 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
15618 kstart=ifrag(1,ipair(1,ii,iset),iset)
15619 kend=ifrag(2,ipair(1,ii,iset),iset)
15620 lstart=ifrag(1,ipair(2,ii,iset),iset)
15621 lend=ifrag(2,ipair(2,ii,iset),iset)
15622 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15623 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
15626 dc(j,i)=cdummy(j,i)
15627 call chainbuild_cart
15630 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15632 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
15636 kstart=ifrag(1,ipair(1,ii,iset),iset)
15637 kend=ifrag(2,ipair(1,ii,iset),iset)
15638 lstart=ifrag(1,ipair(2,ii,iset),iset)
15639 lend=ifrag(2,ipair(2,ii,iset),iset)
15640 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15641 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
15644 ducartan(j,i)=(uzap2-uzap1)/(delta)
15647 ! Calculating numerical gradients for dU/ddx
15649 duxcartan(j,i)=0.0d0
15651 cdummy(j,i)=dc(j,i+nres)
15652 dc(j,i+nres)=dc(j,i+nres)+delta
15653 call chainbuild_cart
15656 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15658 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
15662 kstart=ifrag(1,ipair(1,ii,iset),iset)
15663 kend=ifrag(2,ipair(1,ii,iset),iset)
15664 lstart=ifrag(1,ipair(2,ii,iset),iset)
15665 lend=ifrag(2,ipair(2,ii,iset),iset)
15666 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15667 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
15670 dc(j,i+nres)=cdummy(j,i)
15671 call chainbuild_cart
15674 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
15675 ifrag(2,ii,iset),.true.,idummy,idummy)
15676 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
15680 kstart=ifrag(1,ipair(1,ii,iset),iset)
15681 kend=ifrag(2,ipair(1,ii,iset),iset)
15682 lstart=ifrag(1,ipair(2,ii,iset),iset)
15683 lend=ifrag(2,ipair(2,ii,iset),iset)
15684 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15685 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
15688 duxcartan(j,i)=(uzap2-uzap1)/(delta)
15691 write(iout,*) "Numerical dUconst/ddc backbone "
15693 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
15695 ! write(iout,*) "Numerical dUconst/ddx side-chain "
15697 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
15700 end subroutine dEconstrQ_num
15701 !-----------------------------------------------------------------------------
15703 !-----------------------------------------------------------------------------
15704 subroutine check_energies
15706 ! use random, only: ran_number
15710 ! include 'DIMENSIONS'
15711 ! include 'COMMON.CHAIN'
15712 ! include 'COMMON.VAR'
15713 ! include 'COMMON.IOUNITS'
15714 ! include 'COMMON.SBRIDGE'
15715 ! include 'COMMON.LOCAL'
15716 ! include 'COMMON.GEO'
15718 ! External functions
15719 !EL double precision ran_number
15720 !EL external ran_number
15723 integer :: i,j,k,l,lmax,p,pmax
15724 real(kind=8) :: rmin,rmax
15725 real(kind=8) :: eij
15728 real(kind=8) :: wi,rij,tj,pj
15750 !t wi=ran_number(0.0D0,pi)
15751 ! wi=ran_number(0.0D0,pi/6.0D0)
15753 !t tj=ran_number(0.0D0,pi)
15754 !t pj=ran_number(0.0D0,pi)
15755 ! pj=ran_number(0.0D0,pi/6.0D0)
15759 !t rij=ran_number(rmin,rmax)
15761 c(1,j)=d*sin(pj)*cos(tj)
15762 c(2,j)=d*sin(pj)*sin(tj)
15768 c(3,i)=-rij-d*cos(wi)
15771 dc(k,nres+i)=c(k,nres+i)-c(k,i)
15772 dc_norm(k,nres+i)=dc(k,nres+i)/d
15773 dc(k,nres+j)=c(k,nres+j)-c(k,j)
15774 dc_norm(k,nres+j)=dc(k,nres+j)/d
15777 call dyn_ssbond_ene(i,j,eij)
15782 end subroutine check_energies
15783 !-----------------------------------------------------------------------------
15784 subroutine dyn_ssbond_ene(resi,resj,eij)
15789 ! include 'DIMENSIONS'
15790 ! include 'COMMON.SBRIDGE'
15791 ! include 'COMMON.CHAIN'
15792 ! include 'COMMON.DERIV'
15793 ! include 'COMMON.LOCAL'
15794 ! include 'COMMON.INTERACT'
15795 ! include 'COMMON.VAR'
15796 ! include 'COMMON.IOUNITS'
15797 ! include 'COMMON.CALC'
15801 ! include 'COMMON.MD'
15802 ! use MD, only: totT,t_bath
15805 ! External functions
15806 !EL double precision h_base
15807 !EL external h_base
15810 integer :: resi,resj
15813 real(kind=8) :: eij
15816 logical :: havebond
15817 integer itypi,itypj
15818 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
15819 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
15820 real(kind=8),dimension(3) :: dcosom1,dcosom2
15822 real(kind=8) :: pom1,pom2
15823 real(kind=8) :: ljA,ljB,ljXs
15824 real(kind=8),dimension(1:3) :: d_ljB
15825 real(kind=8) :: ssA,ssB,ssC,ssXs
15826 real(kind=8) :: ssxm,ljxm,ssm,ljm
15827 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
15828 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
15829 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
15830 !-------FIRST METHOD
15832 real(kind=8),dimension(1:3) :: d_xm
15833 !-------END FIRST METHOD
15834 !-------SECOND METHOD
15835 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
15836 !-------END SECOND METHOD
15838 !-------TESTING CODE
15839 !el logical :: checkstop,transgrad
15840 !el common /sschecks/ checkstop,transgrad
15842 integer :: icheck,nicheck,jcheck,njcheck
15843 real(kind=8),dimension(-1:1) :: echeck
15844 real(kind=8) :: deps,ssx0,ljx0
15845 !-------END TESTING CODE
15851 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
15852 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
15855 dxi=dc_norm(1,nres+i)
15856 dyi=dc_norm(2,nres+i)
15857 dzi=dc_norm(3,nres+i)
15858 dsci_inv=vbld_inv(i+nres)
15861 xj=c(1,nres+j)-c(1,nres+i)
15862 yj=c(2,nres+j)-c(2,nres+i)
15863 zj=c(3,nres+j)-c(3,nres+i)
15864 dxj=dc_norm(1,nres+j)
15865 dyj=dc_norm(2,nres+j)
15866 dzj=dc_norm(3,nres+j)
15867 dscj_inv=vbld_inv(j+nres)
15869 chi1=chi(itypi,itypj)
15870 chi2=chi(itypj,itypi)
15877 alf12=0.5D0*(alf1+alf2)
15879 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15880 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
15881 ! The following are set in sc_angular
15885 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
15886 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
15887 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
15889 rij=1.0D0/rij ! Reset this so it makes sense
15891 sig0ij=sigma(itypi,itypj)
15892 sig=sig0ij*dsqrt(1.0D0/sigsq)
15895 ljA=eps1*eps2rt**2*eps3rt**2
15896 ljB=ljA*bb(itypi,itypj)
15897 ljA=ljA*aa(itypi,itypj)
15898 ljxm=ljXs+(-2.0D0*aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
15903 deltat12=om2-om1+2.0d0
15904 cosphi=om12-om1*om2
15908 +akth*(deltat1*deltat1+deltat2*deltat2) &
15909 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
15910 ssxm=ssXs-0.5D0*ssB/ssA
15912 !-------TESTING CODE
15913 !$$$c Some extra output
15914 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
15915 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
15916 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
15917 !$$$ if (ssx0.gt.0.0d0) then
15918 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
15922 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
15923 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
15924 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
15926 !-------END TESTING CODE
15928 !-------TESTING CODE
15929 ! Stop and plot energy and derivative as a function of distance
15930 if (checkstop) then
15931 ssm=ssC-0.25D0*ssB*ssB/ssA
15932 ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
15933 if (ssm.lt.ljm .and. &
15934 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
15942 if (.not.checkstop) then
15947 do icheck=0,nicheck
15948 do jcheck=-1,njcheck
15949 if (checkstop) rij=(ssxm-1.0d0)+ &
15950 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
15951 !-------END TESTING CODE
15953 if (rij.gt.ljxm) then
15956 fac=(1.0D0/ljd)**expon
15957 e1=fac*fac*aa(itypi,itypj)
15958 e2=fac*bb(itypi,itypj)
15959 eij=eps1*eps2rt*eps3rt*(e1+e2)
15962 eij=eij*eps2rt*eps3rt
15965 e1=e1*eps1*eps2rt**2*eps3rt**2
15966 ed=-expon*(e1+eij)/ljd
15968 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
15969 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
15970 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
15971 -2.0D0*alf12*eps3der+sigder*sigsq_om12
15972 else if (rij.lt.ssxm) then
15975 eij=ssA*ssd*ssd+ssB*ssd+ssC
15977 ed=2*akcm*ssd+akct*deltat12
15979 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
15980 eom1=-2*akth*deltat1-pom1-om2*pom2
15981 eom2= 2*akth*deltat2+pom1-om1*pom2
15984 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
15986 d_ssxm(1)=0.5D0*akct/ssA
15987 d_ssxm(2)=-d_ssxm(1)
15990 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
15991 d_ljxm(2)=d_ljxm(1)*sigsq_om2
15992 d_ljxm(3)=d_ljxm(1)*sigsq_om12
15993 d_ljxm(1)=d_ljxm(1)*sigsq_om1
15995 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
15996 xm=0.5d0*(ssxm+ljxm)
15998 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
16000 if (rij.lt.xm) then
16002 ssm=ssC-0.25D0*ssB*ssB/ssA
16003 d_ssm(1)=0.5D0*akct*ssB/ssA
16004 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
16005 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
16007 f1=(rij-xm)/(ssxm-xm)
16008 f2=(rij-ssxm)/(xm-ssxm)
16012 delta_inv=1.0d0/(xm-ssxm)
16013 deltasq_inv=delta_inv*delta_inv
16015 fac1=deltasq_inv*fac*(xm-rij)
16016 fac2=deltasq_inv*fac*(rij-ssxm)
16017 ed=delta_inv*(Ht*hd2-ssm*hd1)
16018 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
16019 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
16020 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
16023 ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
16024 d_ljm(1)=-0.5D0*bb(itypi,itypj)/aa(itypi,itypj)*ljB
16025 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
16026 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
16028 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
16029 f1=(rij-ljxm)/(xm-ljxm)
16030 f2=(rij-xm)/(ljxm-xm)
16034 delta_inv=1.0d0/(ljxm-xm)
16035 deltasq_inv=delta_inv*delta_inv
16037 fac1=deltasq_inv*fac*(ljxm-rij)
16038 fac2=deltasq_inv*fac*(rij-xm)
16039 ed=delta_inv*(ljm*hd2-Ht*hd1)
16040 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
16041 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
16042 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
16044 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
16046 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
16052 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
16053 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
16054 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
16056 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
16057 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
16058 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
16059 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
16060 !$$$ d_ssm(3)=omega
16062 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
16064 !$$$ d_ljm(k)=ljm*d_ljB(k)
16068 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
16069 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
16070 !$$$ d_ss(2)=akct*ssd
16071 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
16072 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
16075 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
16076 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
16077 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
16079 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
16080 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
16082 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
16084 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
16085 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
16086 !$$$ h1=h_base(f1,hd1)
16087 !$$$ h2=h_base(f2,hd2)
16088 !$$$ eij=ss*h1+ljf*h2
16089 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
16090 !$$$ deltasq_inv=delta_inv*delta_inv
16091 !$$$ fac=ljf*hd2-ss*hd1
16092 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
16093 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
16094 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
16095 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
16096 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
16097 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
16098 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
16100 !$$$ havebond=.false.
16101 !$$$ if (ed.gt.0.0d0) havebond=.true.
16102 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
16109 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
16110 ! write(iout,'(a15,f12.2,f8.1,2i5)')
16111 ! & "SSBOND_E_FORM",totT,t_bath,i,j
16115 dyn_ssbond_ij(i,j)=eij
16116 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
16117 dyn_ssbond_ij(i,j)=1.0d300
16120 ! write(iout,'(a15,f12.2,f8.1,2i5)')
16121 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
16126 !-------TESTING CODE
16127 !el if (checkstop) then
16128 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
16129 "CHECKSTOP",rij,eij,ed
16133 if (checkstop) then
16134 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
16137 if (checkstop) then
16141 !-------END TESTING CODE
16144 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
16145 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
16148 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
16151 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
16152 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
16153 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
16154 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
16155 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
16156 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
16160 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
16165 gvdwc(l,i)=gvdwc(l,i)-gg(l)
16166 gvdwc(l,j)=gvdwc(l,j)+gg(l)
16170 end subroutine dyn_ssbond_ene
16171 !-----------------------------------------------------------------------------
16172 real(kind=8) function h_base(x,deriv)
16173 ! A smooth function going 0->1 in range [0,1]
16174 ! It should NOT be called outside range [0,1], it will not work there.
16181 real(kind=8) :: deriv
16184 real(kind=8) :: xsq
16187 ! Two parabolas put together. First derivative zero at extrema
16188 !$$$ if (x.lt.0.5D0) then
16189 !$$$ h_base=2.0D0*x*x
16193 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
16194 !$$$ deriv=4.0D0*deriv
16197 ! Third degree polynomial. First derivative zero at extrema
16198 h_base=x*x*(3.0d0-2.0d0*x)
16199 deriv=6.0d0*x*(1.0d0-x)
16201 ! Fifth degree polynomial. First and second derivatives zero at extrema
16203 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
16205 !$$$ deriv=deriv*deriv
16206 !$$$ deriv=30.0d0*xsq*deriv
16209 end function h_base
16210 !-----------------------------------------------------------------------------
16211 subroutine dyn_set_nss
16212 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
16214 use MD_data, only: totT,t_bath
16216 ! include 'DIMENSIONS'
16220 ! include 'COMMON.SBRIDGE'
16221 ! include 'COMMON.CHAIN'
16222 ! include 'COMMON.IOUNITS'
16223 ! include 'COMMON.SETUP'
16224 ! include 'COMMON.MD'
16226 real(kind=8) :: emin
16227 integer :: i,j,imin,ierr
16228 integer :: diff,allnss,newnss
16229 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
16232 integer,dimension(0:nfgtasks) :: i_newnss
16233 integer,dimension(0:nfgtasks) :: displ
16234 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
16235 integer :: g_newnss
16240 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
16249 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
16253 if (allflag(i).eq.0 .and. &
16254 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
16255 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
16259 if (emin.lt.1.0d300) then
16262 if (allflag(i).eq.0 .and. &
16263 (allihpb(i).eq.allihpb(imin) .or. &
16264 alljhpb(i).eq.allihpb(imin) .or. &
16265 allihpb(i).eq.alljhpb(imin) .or. &
16266 alljhpb(i).eq.alljhpb(imin))) then
16273 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
16277 if (allflag(i).eq.1) then
16279 newihpb(newnss)=allihpb(i)
16280 newjhpb(newnss)=alljhpb(i)
16285 if (nfgtasks.gt.1)then
16287 call MPI_Reduce(newnss,g_newnss,1,&
16288 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
16289 call MPI_Gather(newnss,1,MPI_INTEGER,&
16290 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
16292 do i=1,nfgtasks-1,1
16293 displ(i)=i_newnss(i-1)+displ(i-1)
16295 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
16296 g_newihpb,i_newnss,displ,MPI_INTEGER,&
16298 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
16299 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
16301 if(fg_rank.eq.0) then
16302 ! print *,'g_newnss',g_newnss
16303 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
16304 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
16307 newihpb(i)=g_newihpb(i)
16308 newjhpb(i)=g_newjhpb(i)
16316 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
16321 if (idssb(i).eq.newihpb(j) .and. &
16322 jdssb(i).eq.newjhpb(j)) found=.true.
16326 if (.not.found.and.fg_rank.eq.0) &
16327 write(iout,'(a15,f12.2,f8.1,2i5)') &
16328 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
16336 if (newihpb(i).eq.idssb(j) .and. &
16337 newjhpb(i).eq.jdssb(j)) found=.true.
16341 if (.not.found.and.fg_rank.eq.0) &
16342 write(iout,'(a15,f12.2,f8.1,2i5)') &
16343 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
16350 idssb(i)=newihpb(i)
16351 jdssb(i)=newjhpb(i)
16355 end subroutine dyn_set_nss
16356 !-----------------------------------------------------------------------------
16358 subroutine read_ssHist
16361 ! include 'DIMENSIONS'
16362 ! include "DIMENSIONS.FREE"
16363 ! include 'COMMON.FREE'
16366 character(len=80) :: controlcard
16369 call card_concat(controlcard,.true.)
16370 read(controlcard,*) &
16371 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
16375 end subroutine read_ssHist
16377 !-----------------------------------------------------------------------------
16378 integer function indmat(i,j)
16380 ! get the position of the jth ijth fragment of the chain coordinate system
16381 ! in the fromto array.
16384 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
16386 end function indmat
16387 !-----------------------------------------------------------------------------
16388 real(kind=8) function sigm(x)
16394 !-----------------------------------------------------------------------------
16395 !-----------------------------------------------------------------------------
16396 subroutine alloc_ener_arrays
16397 !EL Allocation of arrays used by module energy
16398 use MD_data, only: mset
16399 !el local variables
16402 if(nres.lt.100) then
16404 elseif(nres.lt.200) then
16405 maxconts=0.8*nres ! Max. number of contacts per residue
16407 maxconts=0.6*nres ! (maxconts=maxres/4)
16409 maxcont=12*nres ! Max. number of SC contacts
16410 maxvar=6*nres ! Max. number of variables
16411 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
16412 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
16413 !----------------------
16414 ! arrays in subroutine init_int_table
16416 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
16417 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
16419 allocate(nint_gr(nres))
16420 allocate(nscp_gr(nres))
16421 allocate(ielstart(nres))
16422 allocate(ielend(nres))
16424 allocate(istart(nres,maxint_gr))
16425 allocate(iend(nres,maxint_gr))
16426 !(maxres,maxint_gr)
16427 allocate(iscpstart(nres,maxint_gr))
16428 allocate(iscpend(nres,maxint_gr))
16429 !(maxres,maxint_gr)
16430 allocate(ielstart_vdw(nres))
16431 allocate(ielend_vdw(nres))
16434 allocate(lentyp(0:nfgtasks-1))
16436 !----------------------
16438 ! common /contacts/
16439 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
16440 allocate(icont(2,maxcont))
16442 ! common /contacts1/
16443 allocate(num_cont(0:nres+4))
16445 allocate(jcont(maxconts,nres))
16447 allocate(facont(maxconts,nres))
16449 allocate(gacont(3,maxconts,nres))
16450 !(3,maxconts,maxres)
16451 ! common /contacts_hb/
16452 allocate(gacontp_hb1(3,maxconts,nres))
16453 allocate(gacontp_hb2(3,maxconts,nres))
16454 allocate(gacontp_hb3(3,maxconts,nres))
16455 allocate(gacontm_hb1(3,maxconts,nres))
16456 allocate(gacontm_hb2(3,maxconts,nres))
16457 allocate(gacontm_hb3(3,maxconts,nres))
16458 allocate(gacont_hbr(3,maxconts,nres))
16459 allocate(grij_hb_cont(3,maxconts,nres))
16460 !(3,maxconts,maxres)
16461 allocate(facont_hb(maxconts,nres))
16462 allocate(ees0p(maxconts,nres))
16463 allocate(ees0m(maxconts,nres))
16464 allocate(d_cont(maxconts,nres))
16466 allocate(num_cont_hb(nres))
16468 allocate(jcont_hb(maxconts,nres))
16471 allocate(Ug(2,2,nres))
16472 allocate(Ugder(2,2,nres))
16473 allocate(Ug2(2,2,nres))
16474 allocate(Ug2der(2,2,nres))
16476 allocate(obrot(2,nres))
16477 allocate(obrot2(2,nres))
16478 allocate(obrot_der(2,nres))
16479 allocate(obrot2_der(2,nres))
16481 ! common /precomp1/
16482 allocate(mu(2,nres))
16483 allocate(muder(2,nres))
16484 allocate(Ub2(2,nres))
16487 allocate(Ub2der(2,nres))
16488 allocate(Ctobr(2,nres))
16489 allocate(Ctobrder(2,nres))
16490 allocate(Dtobr2(2,nres))
16491 allocate(Dtobr2der(2,nres))
16493 allocate(EUg(2,2,nres))
16494 allocate(EUgder(2,2,nres))
16495 allocate(CUg(2,2,nres))
16496 allocate(CUgder(2,2,nres))
16497 allocate(DUg(2,2,nres))
16498 allocate(Dugder(2,2,nres))
16499 allocate(DtUg2(2,2,nres))
16500 allocate(DtUg2der(2,2,nres))
16502 ! common /precomp2/
16503 allocate(Ug2Db1t(2,nres))
16504 allocate(Ug2Db1tder(2,nres))
16505 allocate(CUgb2(2,nres))
16506 allocate(CUgb2der(2,nres))
16508 allocate(EUgC(2,2,nres))
16509 allocate(EUgCder(2,2,nres))
16510 allocate(EUgD(2,2,nres))
16511 allocate(EUgDder(2,2,nres))
16512 allocate(DtUg2EUg(2,2,nres))
16513 allocate(Ug2DtEUg(2,2,nres))
16515 allocate(Ug2DtEUgder(2,2,2,nres))
16516 allocate(DtUg2EUgder(2,2,2,nres))
16518 ! common /rotat_old/
16519 allocate(costab(nres))
16520 allocate(sintab(nres))
16521 allocate(costab2(nres))
16522 allocate(sintab2(nres))
16525 allocate(a_chuj(2,2,maxconts,nres))
16526 !(2,2,maxconts,maxres)(maxconts=maxres/4)
16527 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
16528 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
16529 ! common /contdistrib/
16530 allocate(ncont_sent(nres))
16531 allocate(ncont_recv(nres))
16533 allocate(iat_sent(nres))
16535 allocate(iint_sent(4,nres,nres))
16536 allocate(iint_sent_local(4,nres,nres))
16538 allocate(iturn3_sent(4,0:nres+4))
16539 allocate(iturn4_sent(4,0:nres+4))
16540 allocate(iturn3_sent_local(4,nres))
16541 allocate(iturn4_sent_local(4,nres))
16543 allocate(itask_cont_from(0:nfgtasks-1))
16544 allocate(itask_cont_to(0:nfgtasks-1))
16545 !(0:max_fg_procs-1)
16549 !----------------------
16552 allocate(dcdv(6,maxdim))
16553 allocate(dxdv(6,maxdim))
16555 allocate(dxds(6,nres))
16557 allocate(gradx(3,nres,0:2))
16558 allocate(gradc(3,nres,0:2))
16560 allocate(gvdwx(3,nres))
16561 allocate(gvdwc(3,nres))
16562 allocate(gelc(3,nres))
16563 allocate(gelc_long(3,nres))
16564 allocate(gvdwpp(3,nres))
16565 allocate(gvdwc_scpp(3,nres))
16566 allocate(gradx_scp(3,nres))
16567 allocate(gvdwc_scp(3,nres))
16568 allocate(ghpbx(3,nres))
16569 allocate(ghpbc(3,nres))
16570 allocate(gradcorr(3,nres))
16571 allocate(gradcorr_long(3,nres))
16572 allocate(gradcorr5_long(3,nres))
16573 allocate(gradcorr6_long(3,nres))
16574 allocate(gcorr6_turn_long(3,nres))
16575 allocate(gradxorr(3,nres))
16576 allocate(gradcorr5(3,nres))
16577 allocate(gradcorr6(3,nres))
16579 allocate(gloc(0:maxvar,0:2))
16580 allocate(gloc_x(0:maxvar,2))
16582 allocate(gel_loc(3,nres))
16583 allocate(gel_loc_long(3,nres))
16584 allocate(gcorr3_turn(3,nres))
16585 allocate(gcorr4_turn(3,nres))
16586 allocate(gcorr6_turn(3,nres))
16587 allocate(gradb(3,nres))
16588 allocate(gradbx(3,nres))
16590 allocate(gel_loc_loc(maxvar))
16591 allocate(gel_loc_turn3(maxvar))
16592 allocate(gel_loc_turn4(maxvar))
16593 allocate(gel_loc_turn6(maxvar))
16594 allocate(gcorr_loc(maxvar))
16595 allocate(g_corr5_loc(maxvar))
16596 allocate(g_corr6_loc(maxvar))
16598 allocate(gsccorc(3,nres))
16599 allocate(gsccorx(3,nres))
16601 allocate(gsccor_loc(nres))
16603 allocate(dtheta(3,2,nres))
16605 allocate(gscloc(3,nres))
16606 allocate(gsclocx(3,nres))
16608 allocate(dphi(3,3,nres))
16609 allocate(dalpha(3,3,nres))
16610 allocate(domega(3,3,nres))
16612 ! common /deriv_scloc/
16613 allocate(dXX_C1tab(3,nres))
16614 allocate(dYY_C1tab(3,nres))
16615 allocate(dZZ_C1tab(3,nres))
16616 allocate(dXX_Ctab(3,nres))
16617 allocate(dYY_Ctab(3,nres))
16618 allocate(dZZ_Ctab(3,nres))
16619 allocate(dXX_XYZtab(3,nres))
16620 allocate(dYY_XYZtab(3,nres))
16621 allocate(dZZ_XYZtab(3,nres))
16624 allocate(jgrad_start(nres))
16625 allocate(jgrad_end(nres))
16627 !----------------------
16630 allocate(ibond_displ(0:nfgtasks-1))
16631 allocate(ibond_count(0:nfgtasks-1))
16632 allocate(ithet_displ(0:nfgtasks-1))
16633 allocate(ithet_count(0:nfgtasks-1))
16634 allocate(iphi_displ(0:nfgtasks-1))
16635 allocate(iphi_count(0:nfgtasks-1))
16636 allocate(iphi1_displ(0:nfgtasks-1))
16637 allocate(iphi1_count(0:nfgtasks-1))
16638 allocate(ivec_displ(0:nfgtasks-1))
16639 allocate(ivec_count(0:nfgtasks-1))
16640 allocate(iset_displ(0:nfgtasks-1))
16641 allocate(iset_count(0:nfgtasks-1))
16642 allocate(iint_count(0:nfgtasks-1))
16643 allocate(iint_displ(0:nfgtasks-1))
16644 !(0:max_fg_procs-1)
16645 !----------------------
16648 allocate(gcart(3,0:nres))
16649 allocate(gxcart(3,0:nres))
16651 allocate(gradcag(3,nres))
16652 allocate(gradxag(3,nres))
16654 ! common /back_constr/
16655 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
16656 allocate(dutheta(nres))
16657 allocate(dugamma(nres))
16659 allocate(duscdiff(3,nres))
16660 allocate(duscdiffx(3,nres))
16662 !el i io:read_fragments
16663 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
16664 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
16666 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
16667 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
16668 allocate(mset(0:nprocs)) !(maxprocs/20)
16670 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
16671 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
16672 allocate(dUdconst(3,0:nres))
16673 allocate(dUdxconst(3,0:nres))
16674 allocate(dqwol(3,0:nres))
16675 allocate(dxqwol(3,0:nres))
16677 !----------------------
16679 ! common /sbridge/ in io_common: read_bridge
16680 !el allocate((:),allocatable :: iss !(maxss)
16681 ! common /links/ in io_common: read_bridge
16682 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
16683 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
16684 ! common /dyn_ssbond/
16685 ! and side-chain vectors in theta or phi.
16686 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
16690 dyn_ssbond_ij(:,:)=1.0d300
16695 allocate(idssb(nss),jdssb(nss))
16698 allocate(dyn_ss_mask(nres))
16700 dyn_ss_mask(:)=.false.
16701 !----------------------
16703 ! Parameters of the SCCOR term
16705 !el in io_conf: parmread
16706 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
16707 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
16708 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
16709 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
16710 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
16711 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
16712 ! allocate(vlor1sccor(maxterm_sccor,20,20))
16713 ! allocate(vlor2sccor(maxterm_sccor,20,20))
16714 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
16716 allocate(gloc_sc(3,0:2*nres,0:10))
16717 !(3,0:maxres2,10)maxres2=2*maxres
16718 allocate(dcostau(3,3,3,2*nres))
16719 allocate(dsintau(3,3,3,2*nres))
16720 allocate(dtauangle(3,3,3,2*nres))
16721 allocate(dcosomicron(3,3,3,2*nres))
16722 allocate(domicron(3,3,3,2*nres))
16723 !(3,3,3,maxres2)maxres2=2*maxres
16724 !----------------------
16727 allocate(varall(maxvar))
16728 !(maxvar)(maxvar=6*maxres)
16729 allocate(mask_theta(nres))
16730 allocate(mask_phi(nres))
16731 allocate(mask_side(nres))
16733 !----------------------
16736 allocate(uy(3,nres))
16737 allocate(uz(3,nres))
16739 allocate(uygrad(3,3,2,nres))
16740 allocate(uzgrad(3,3,2,nres))
16744 end subroutine alloc_ener_arrays
16745 !-----------------------------------------------------------------------------
16746 !-----------------------------------------------------------------------------