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
2694 xmedi=dmod(xmedi,boxxsize)
2695 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2696 ymedi=dmod(ymedi,boxysize)
2697 if (ymedi.lt.0) ymedi=ymedi+boxysize
2698 zmedi=dmod(zmedi,boxzsize)
2699 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2701 call eelecij(i,i+2,ees,evdw1,eel_loc)
2702 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2703 num_cont_hb(i)=num_conti
2705 do i=iturn4_start,iturn4_end
2706 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
2707 .or. itype(i+3).eq.ntyp1 &
2708 .or. itype(i+4).eq.ntyp1) cycle
2712 dx_normi=dc_norm(1,i)
2713 dy_normi=dc_norm(2,i)
2714 dz_normi=dc_norm(3,i)
2715 xmedi=c(1,i)+0.5d0*dxi
2716 ymedi=c(2,i)+0.5d0*dyi
2717 zmedi=c(3,i)+0.5d0*dzi
2718 xmedi=dmod(xmedi,boxxsize)
2719 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2720 ymedi=dmod(ymedi,boxysize)
2721 if (ymedi.lt.0) ymedi=ymedi+boxysize
2722 zmedi=dmod(zmedi,boxzsize)
2723 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2724 num_conti=num_cont_hb(i)
2725 call eelecij(i,i+3,ees,evdw1,eel_loc)
2726 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
2727 call eturn4(i,eello_turn4)
2728 num_cont_hb(i)=num_conti
2731 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2733 do i=iatel_s,iatel_e
2734 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2738 dx_normi=dc_norm(1,i)
2739 dy_normi=dc_norm(2,i)
2740 dz_normi=dc_norm(3,i)
2741 xmedi=c(1,i)+0.5d0*dxi
2742 ymedi=c(2,i)+0.5d0*dyi
2743 zmedi=c(3,i)+0.5d0*dzi
2744 xmedi=dmod(xmedi,boxxsize)
2745 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2746 ymedi=dmod(ymedi,boxysize)
2747 if (ymedi.lt.0) ymedi=ymedi+boxysize
2748 zmedi=dmod(zmedi,boxzsize)
2749 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2751 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2752 num_conti=num_cont_hb(i)
2753 do j=ielstart(i),ielend(i)
2754 ! write (iout,*) i,j,itype(i),itype(j)
2755 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2756 call eelecij(i,j,ees,evdw1,eel_loc)
2758 num_cont_hb(i)=num_conti
2760 ! write (iout,*) "Number of loop steps in EELEC:",ind
2762 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
2763 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2765 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2766 !cc eel_loc=eel_loc+eello_turn3
2767 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
2769 end subroutine eelec
2770 !-----------------------------------------------------------------------------
2771 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2774 ! implicit real*8 (a-h,o-z)
2775 ! include 'DIMENSIONS'
2779 ! include 'COMMON.CONTROL'
2780 ! include 'COMMON.IOUNITS'
2781 ! include 'COMMON.GEO'
2782 ! include 'COMMON.VAR'
2783 ! include 'COMMON.LOCAL'
2784 ! include 'COMMON.CHAIN'
2785 ! include 'COMMON.DERIV'
2786 ! include 'COMMON.INTERACT'
2787 ! include 'COMMON.CONTACTS'
2788 ! include 'COMMON.TORSION'
2789 ! include 'COMMON.VECTORS'
2790 ! include 'COMMON.FFIELD'
2791 ! include 'COMMON.TIME1'
2792 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
2793 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2794 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2795 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2796 real(kind=8),dimension(4) :: muij
2797 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
2798 dist_temp, dist_init
2799 integer xshift,yshift,zshift
2800 !el integer :: num_conti,j1,j2
2801 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2802 !el dz_normi,xmedi,ymedi,zmedi
2804 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2805 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
2808 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2810 real(kind=8) :: scal_el=1.0d0
2812 real(kind=8) :: scal_el=0.5d0
2815 ! 13-go grudnia roku pamietnego...
2816 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
2818 0.0d0,0.0d0,1.0d0/),shape(unmat))
2819 ! integer :: maxconts=nres/4
2821 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
2822 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
2823 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
2824 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
2825 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
2826 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
2827 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
2828 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
2829 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
2830 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
2831 ecosgp,ecosam,ecosbm,ecosgm,ghalf
2833 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
2834 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
2836 ! time00=MPI_Wtime()
2837 !d write (iout,*) "eelecij",i,j
2841 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2842 aaa=app(iteli,itelj)
2843 bbb=bpp(iteli,itelj)
2844 ael6i=ael6(iteli,itelj)
2845 ael3i=ael3(iteli,itelj)
2849 dx_normj=dc_norm(1,j)
2850 dy_normj=dc_norm(2,j)
2851 dz_normj=dc_norm(3,j)
2852 ! xj=c(1,j)+0.5D0*dxj-xmedi
2853 ! yj=c(2,j)+0.5D0*dyj-ymedi
2854 ! zj=c(3,j)+0.5D0*dzj-zmedi
2859 if (xj.lt.0) xj=xj+boxxsize
2861 if (yj.lt.0) yj=yj+boxysize
2863 if (zj.lt.0) zj=zj+boxzsize
2864 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2871 xj=xj_safe+xshift*boxxsize
2872 yj=yj_safe+yshift*boxysize
2873 zj=zj_safe+zshift*boxzsize
2874 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2875 if(dist_temp.lt.dist_init) then
2885 if (isubchap.eq.1) then
2896 rij=xj*xj+yj*yj+zj*zj
2899 sss_ele_cut=sscale_ele(rij)
2900 sss_ele_grad=sscagrad_ele(rij)
2901 ! print *,sss_ele_cut,sss_ele_grad,&
2902 ! (rij),r_cut_ele,rlamb_ele
2903 if (sss_ele_cut.le.0.0) go to 128
2908 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2909 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2910 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2911 fac=cosa-3.0D0*cosb*cosg
2913 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2914 if (j.eq.i+2) ev1=scal_el*ev1
2919 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2922 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
2923 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2924 ees=ees+eesij*sss_ele_cut
2925 evdw1=evdw1+evdwij*sss_ele_cut
2926 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2927 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2928 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2929 !d & xmedi,ymedi,zmedi,xj,yj,zj
2931 if (energy_dec) then
2932 ! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
2933 ! 'evdw1',i,j,evdwij,&
2934 ! iteli,itelj,aaa,evdw1
2935 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
2936 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2939 ! Calculate contributions to the Cartesian gradient.
2942 facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut
2943 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
2949 ! Radial derivatives. First process both termini of the fragment (i,j)
2955 ! ghalf=0.5D0*ggg(k)
2956 ! gelc(k,i)=gelc(k,i)+ghalf
2957 ! gelc(k,j)=gelc(k,j)+ghalf
2959 ! 9/28/08 AL Gradient compotents will be summed only at the end
2961 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2962 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2965 ! Loop over residues i+1 thru j-1.
2969 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2972 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj
2973 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj
2974 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj
2976 ! ghalf=0.5D0*ggg(k)
2977 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2978 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2980 ! 9/28/08 AL Gradient compotents will be summed only at the end
2982 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2983 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2986 ! Loop over residues i+1 thru j-1.
2990 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2994 facvdw=(ev1+evdwij)*sss_ele_cut
2995 facel=(el1+eesij)*sss_ele_cut
2997 fac=-3*rrmij*(facvdw+facvdw+facel)
3002 ! Radial derivatives. First process both termini of the fragment (i,j)
3004 ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj
3005 ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj
3006 ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj
3008 ! ghalf=0.5D0*ggg(k)
3009 ! gelc(k,i)=gelc(k,i)+ghalf
3010 ! gelc(k,j)=gelc(k,j)+ghalf
3012 ! 9/28/08 AL Gradient compotents will be summed only at the end
3014 gelc_long(k,j)=gelc(k,j)+ggg(k)
3015 gelc_long(k,i)=gelc(k,i)-ggg(k)
3018 ! Loop over residues i+1 thru j-1.
3022 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3025 ! 9/28/08 AL Gradient compotents will be summed only at the end
3030 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3031 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3037 ecosa=2.0D0*fac3*fac1+fac4
3040 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3041 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3043 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3044 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3046 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3047 !d & (dcosg(k),k=1,3)
3049 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3052 ! ghalf=0.5D0*ggg(k)
3053 ! gelc(k,i)=gelc(k,i)+ghalf
3054 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3055 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3056 ! gelc(k,j)=gelc(k,j)+ghalf
3057 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3058 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3062 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3066 gelc(k,i)=gelc(k,i) &
3067 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3068 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3069 gelc(k,j)=gelc(k,j) &
3070 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3071 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3072 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3073 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3076 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3077 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
3078 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3080 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3081 ! energy of a peptide unit is assumed in the form of a second-order
3082 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3083 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3084 ! are computed for EVERY pair of non-contiguous peptide groups.
3086 if (j.lt.nres-1) then
3097 muij(kkk)=mu(k,i)*mu(l,j)
3100 !d write (iout,*) 'EELEC: i',i,' j',j
3101 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
3102 !d write(iout,*) 'muij',muij
3103 ury=scalar(uy(1,i),erij)
3104 urz=scalar(uz(1,i),erij)
3105 vry=scalar(uy(1,j),erij)
3106 vrz=scalar(uz(1,j),erij)
3107 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3108 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3109 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3110 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3111 fac=dsqrt(-ael6i)*r3ij
3116 !d write (iout,'(4i5,4f10.5)')
3117 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3118 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3119 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3120 !d & uy(:,j),uz(:,j)
3121 !d write (iout,'(4f10.5)')
3122 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3123 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3124 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
3125 !d write (iout,'(9f10.5/)')
3126 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3127 ! Derivatives of the elements of A in virtual-bond vectors
3128 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3130 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3131 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3132 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3133 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3134 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3135 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3136 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3137 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3138 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3139 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3140 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3141 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3143 ! Compute radial contributions to the gradient
3161 ! Add the contributions coming from er
3164 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3165 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3166 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3167 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3170 ! Derivatives in DC(i)
3171 !grad ghalf1=0.5d0*agg(k,1)
3172 !grad ghalf2=0.5d0*agg(k,2)
3173 !grad ghalf3=0.5d0*agg(k,3)
3174 !grad ghalf4=0.5d0*agg(k,4)
3175 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
3176 -3.0d0*uryg(k,2)*vry)!+ghalf1
3177 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
3178 -3.0d0*uryg(k,2)*vrz)!+ghalf2
3179 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
3180 -3.0d0*urzg(k,2)*vry)!+ghalf3
3181 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
3182 -3.0d0*urzg(k,2)*vrz)!+ghalf4
3183 ! Derivatives in DC(i+1)
3184 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
3185 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3186 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
3187 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3188 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
3189 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3190 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
3191 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3192 ! Derivatives in DC(j)
3193 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
3194 -3.0d0*vryg(k,2)*ury)!+ghalf1
3195 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
3196 -3.0d0*vrzg(k,2)*ury)!+ghalf2
3197 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
3198 -3.0d0*vryg(k,2)*urz)!+ghalf3
3199 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
3200 -3.0d0*vrzg(k,2)*urz)!+ghalf4
3201 ! Derivatives in DC(j+1) or DC(nres-1)
3202 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
3203 -3.0d0*vryg(k,3)*ury)
3204 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
3205 -3.0d0*vrzg(k,3)*ury)
3206 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
3207 -3.0d0*vryg(k,3)*urz)
3208 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
3209 -3.0d0*vrzg(k,3)*urz)
3210 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
3212 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3225 aggi(k,l)=-aggi(k,l)
3226 aggi1(k,l)=-aggi1(k,l)
3227 aggj(k,l)=-aggj(k,l)
3228 aggj1(k,l)=-aggj1(k,l)
3231 if (j.lt.nres-1) then
3237 aggi(k,l)=-aggi(k,l)
3238 aggi1(k,l)=-aggi1(k,l)
3239 aggj(k,l)=-aggj(k,l)
3240 aggj1(k,l)=-aggj1(k,l)
3251 aggi(k,l)=-aggi(k,l)
3252 aggi1(k,l)=-aggi1(k,l)
3253 aggj(k,l)=-aggj(k,l)
3254 aggj1(k,l)=-aggj1(k,l)
3259 IF (wel_loc.gt.0.0d0) THEN
3260 ! Contribution to the local-electrostatic energy coming from the i-j pair
3261 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
3263 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3265 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3266 'eelloc',i,j,eel_loc_ij
3267 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
3268 ! if (energy_dec) write (iout,*) "muij",muij
3269 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3271 eel_loc=eel_loc+eel_loc_ij
3272 ! Partial derivatives in virtual-bond dihedral angles gamma
3274 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
3275 a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
3276 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3277 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
3278 a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
3279 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3280 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3282 ggg(l)=agg(l,1)*muij(1)+ &
3283 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3284 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3285 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3286 !grad ghalf=0.5d0*ggg(l)
3287 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
3288 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
3292 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3295 ! Remaining derivatives of eello
3297 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ &
3298 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3299 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ &
3300 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3301 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ &
3302 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3303 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ &
3304 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3307 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
3308 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
3309 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
3310 .and. num_conti.le.maxconts) then
3311 ! write (iout,*) i,j," entered corr"
3313 ! Calculate the contact function. The ith column of the array JCONT will
3314 ! contain the numbers of atoms that make contacts with the atom I (of numbers
3315 ! greater than I). The arrays FACONT and GACONT will contain the values of
3316 ! the contact function and its derivative.
3317 ! r0ij=1.02D0*rpp(iteli,itelj)
3318 ! r0ij=1.11D0*rpp(iteli,itelj)
3319 r0ij=2.20D0*rpp(iteli,itelj)
3320 ! r0ij=1.55D0*rpp(iteli,itelj)
3321 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3322 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
3323 if (fcont.gt.0.0D0) then
3324 num_conti=num_conti+1
3325 if (num_conti.gt.maxconts) then
3326 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
3327 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
3328 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
3329 ' will skip next contacts for this conf.', num_conti
3331 jcont_hb(num_conti,i)=j
3332 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
3333 !d & " jcont_hb",jcont_hb(num_conti,i)
3334 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
3335 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3336 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3338 d_cont(num_conti,i)=rij
3339 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3340 ! --- Electrostatic-interaction matrix ---
3341 a_chuj(1,1,num_conti,i)=a22
3342 a_chuj(1,2,num_conti,i)=a23
3343 a_chuj(2,1,num_conti,i)=a32
3344 a_chuj(2,2,num_conti,i)=a33
3345 ! --- Gradient of rij
3347 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3354 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3355 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3356 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3357 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3358 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3363 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3364 ! Calculate contact energies
3366 wij=cosa-3.0D0*cosb*cosg
3369 ! fac3=dsqrt(-ael6i)/r0ij**3
3370 fac3=dsqrt(-ael6i)*r3ij
3371 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3372 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3373 if (ees0tmp.gt.0) then
3374 ees0pij=dsqrt(ees0tmp)
3378 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3379 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3380 if (ees0tmp.gt.0) then
3381 ees0mij=dsqrt(ees0tmp)
3386 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3387 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3388 ! Diagnostics. Comment out or remove after debugging!
3389 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3390 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3391 ! ees0m(num_conti,i)=0.0D0
3393 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3394 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3395 ! Angular derivatives of the contact function
3396 ees0pij1=fac3/ees0pij
3397 ees0mij1=fac3/ees0mij
3398 fac3p=-3.0D0*fac3*rrmij
3399 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3400 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3402 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3403 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3404 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3405 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3406 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3407 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3408 ecosap=ecosa1+ecosa2
3409 ecosbp=ecosb1+ecosb2
3410 ecosgp=ecosg1+ecosg2
3411 ecosam=ecosa1-ecosa2
3412 ecosbm=ecosb1-ecosb2
3413 ecosgm=ecosg1-ecosg2
3422 facont_hb(num_conti,i)=fcont
3423 fprimcont=fprimcont/rij
3424 !d facont_hb(num_conti,i)=1.0D0
3425 ! Following line is for diagnostics.
3428 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3429 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3432 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3433 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3435 gggp(1)=gggp(1)+ees0pijp*xj
3436 gggp(2)=gggp(2)+ees0pijp*yj
3437 gggp(3)=gggp(3)+ees0pijp*zj
3438 gggm(1)=gggm(1)+ees0mijp*xj
3439 gggm(2)=gggm(2)+ees0mijp*yj
3440 gggm(3)=gggm(3)+ees0mijp*zj
3441 ! Derivatives due to the contact function
3442 gacont_hbr(1,num_conti,i)=fprimcont*xj
3443 gacont_hbr(2,num_conti,i)=fprimcont*yj
3444 gacont_hbr(3,num_conti,i)=fprimcont*zj
3447 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
3448 ! following the change of gradient-summation algorithm.
3450 !grad ghalfp=0.5D0*gggp(k)
3451 !grad ghalfm=0.5D0*gggm(k)
3452 gacontp_hb1(k,num_conti,i)= & !ghalfp+
3453 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3454 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3455 gacontp_hb2(k,num_conti,i)= & !ghalfp+
3456 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3457 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3458 gacontp_hb3(k,num_conti,i)=gggp(k)
3459 gacontm_hb1(k,num_conti,i)= & !ghalfm+
3460 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3461 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3462 gacontm_hb2(k,num_conti,i)= & !ghalfm+
3463 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3464 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3465 gacontm_hb3(k,num_conti,i)=gggm(k)
3467 ! Diagnostics. Comment out or remove after debugging!
3469 !diag gacontp_hb1(k,num_conti,i)=0.0D0
3470 !diag gacontp_hb2(k,num_conti,i)=0.0D0
3471 !diag gacontp_hb3(k,num_conti,i)=0.0D0
3472 !diag gacontm_hb1(k,num_conti,i)=0.0D0
3473 !diag gacontm_hb2(k,num_conti,i)=0.0D0
3474 !diag gacontm_hb3(k,num_conti,i)=0.0D0
3477 endif ! num_conti.le.maxconts
3480 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3483 ghalf=0.5d0*agg(l,k)
3484 aggi(l,k)=aggi(l,k)+ghalf
3485 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3486 aggj(l,k)=aggj(l,k)+ghalf
3489 if (j.eq.nres-1 .and. i.lt.j-2) then
3492 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3497 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
3499 end subroutine eelecij
3500 !-----------------------------------------------------------------------------
3501 subroutine eturn3(i,eello_turn3)
3502 ! Third- and fourth-order contributions from turns
3505 ! implicit real*8 (a-h,o-z)
3506 ! include 'DIMENSIONS'
3507 ! include 'COMMON.IOUNITS'
3508 ! include 'COMMON.GEO'
3509 ! include 'COMMON.VAR'
3510 ! include 'COMMON.LOCAL'
3511 ! include 'COMMON.CHAIN'
3512 ! include 'COMMON.DERIV'
3513 ! include 'COMMON.INTERACT'
3514 ! include 'COMMON.CONTACTS'
3515 ! include 'COMMON.TORSION'
3516 ! include 'COMMON.VECTORS'
3517 ! include 'COMMON.FFIELD'
3518 ! include 'COMMON.CONTROL'
3519 real(kind=8),dimension(3) :: ggg
3520 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
3521 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
3522 real(kind=8),dimension(2) :: auxvec,auxvec1
3523 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3524 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
3525 !el integer :: num_conti,j1,j2
3526 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3527 !el dz_normi,xmedi,ymedi,zmedi
3529 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3530 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3534 real(kind=8) :: eello_turn3
3537 ! write (iout,*) "eturn3",i,j,j1,j2
3542 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3544 ! Third-order contributions
3551 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3552 !d call checkint_turn3(i,a_temp,eello_turn3_num)
3553 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3554 call transpose2(auxmat(1,1),auxmat1(1,1))
3555 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3556 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3557 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3558 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3559 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
3560 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
3561 !d & ' eello_turn3_num',4*eello_turn3_num
3562 ! Derivatives in gamma(i)
3563 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3564 call transpose2(auxmat2(1,1),auxmat3(1,1))
3565 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3566 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3567 ! Derivatives in gamma(i+1)
3568 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3569 call transpose2(auxmat2(1,1),auxmat3(1,1))
3570 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3571 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
3572 +0.5d0*(pizda(1,1)+pizda(2,2))
3573 ! Cartesian derivatives
3575 ! ghalf1=0.5d0*agg(l,1)
3576 ! ghalf2=0.5d0*agg(l,2)
3577 ! ghalf3=0.5d0*agg(l,3)
3578 ! ghalf4=0.5d0*agg(l,4)
3579 a_temp(1,1)=aggi(l,1)!+ghalf1
3580 a_temp(1,2)=aggi(l,2)!+ghalf2
3581 a_temp(2,1)=aggi(l,3)!+ghalf3
3582 a_temp(2,2)=aggi(l,4)!+ghalf4
3583 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3584 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
3585 +0.5d0*(pizda(1,1)+pizda(2,2))
3586 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3587 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3588 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3589 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3590 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3591 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
3592 +0.5d0*(pizda(1,1)+pizda(2,2))
3593 a_temp(1,1)=aggj(l,1)!+ghalf1
3594 a_temp(1,2)=aggj(l,2)!+ghalf2
3595 a_temp(2,1)=aggj(l,3)!+ghalf3
3596 a_temp(2,2)=aggj(l,4)!+ghalf4
3597 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3598 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
3599 +0.5d0*(pizda(1,1)+pizda(2,2))
3600 a_temp(1,1)=aggj1(l,1)
3601 a_temp(1,2)=aggj1(l,2)
3602 a_temp(2,1)=aggj1(l,3)
3603 a_temp(2,2)=aggj1(l,4)
3604 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3605 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
3606 +0.5d0*(pizda(1,1)+pizda(2,2))
3609 end subroutine eturn3
3610 !-----------------------------------------------------------------------------
3611 subroutine eturn4(i,eello_turn4)
3612 ! Third- and fourth-order contributions from turns
3615 ! implicit real*8 (a-h,o-z)
3616 ! include 'DIMENSIONS'
3617 ! include 'COMMON.IOUNITS'
3618 ! include 'COMMON.GEO'
3619 ! include 'COMMON.VAR'
3620 ! include 'COMMON.LOCAL'
3621 ! include 'COMMON.CHAIN'
3622 ! include 'COMMON.DERIV'
3623 ! include 'COMMON.INTERACT'
3624 ! include 'COMMON.CONTACTS'
3625 ! include 'COMMON.TORSION'
3626 ! include 'COMMON.VECTORS'
3627 ! include 'COMMON.FFIELD'
3628 ! include 'COMMON.CONTROL'
3629 real(kind=8),dimension(3) :: ggg
3630 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
3631 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
3632 real(kind=8),dimension(2) :: auxvec,auxvec1
3633 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3634 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
3635 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3636 !el dz_normi,xmedi,ymedi,zmedi
3637 !el integer :: num_conti,j1,j2
3638 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3639 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3642 integer :: i,j,iti1,iti2,iti3,l
3643 real(kind=8) :: eello_turn4,s1,s2,s3
3646 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3648 ! Fourth-order contributions
3656 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3657 !d call checkint_turn4(i,a_temp,eello_turn4_num)
3658 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3663 iti1=itortyp(itype(i+1))
3664 iti2=itortyp(itype(i+2))
3665 iti3=itortyp(itype(i+3))
3666 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3667 call transpose2(EUg(1,1,i+1),e1t(1,1))
3668 call transpose2(Eug(1,1,i+2),e2t(1,1))
3669 call transpose2(Eug(1,1,i+3),e3t(1,1))
3670 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3671 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3672 s1=scalar2(b1(1,iti2),auxvec(1))
3673 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3674 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3675 s2=scalar2(b1(1,iti1),auxvec(1))
3676 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3677 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3678 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3679 eello_turn4=eello_turn4-(s1+s2+s3)
3680 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3681 'eturn4',i,j,-(s1+s2+s3)
3682 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3683 !d & ' eello_turn4_num',8*eello_turn4_num
3684 ! Derivatives in gamma(i)
3685 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3686 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3687 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3688 s1=scalar2(b1(1,iti2),auxvec(1))
3689 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3690 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3691 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3692 ! Derivatives in gamma(i+1)
3693 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3694 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3695 s2=scalar2(b1(1,iti1),auxvec(1))
3696 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3697 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3698 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3699 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3700 ! Derivatives in gamma(i+2)
3701 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3702 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3703 s1=scalar2(b1(1,iti2),auxvec(1))
3704 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3705 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3706 s2=scalar2(b1(1,iti1),auxvec(1))
3707 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3708 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3709 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3710 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3711 ! Cartesian derivatives
3712 ! Derivatives of this turn contributions in DC(i+2)
3713 if (j.lt.nres-1) then
3715 a_temp(1,1)=agg(l,1)
3716 a_temp(1,2)=agg(l,2)
3717 a_temp(2,1)=agg(l,3)
3718 a_temp(2,2)=agg(l,4)
3719 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3720 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3721 s1=scalar2(b1(1,iti2),auxvec(1))
3722 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3723 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3724 s2=scalar2(b1(1,iti1),auxvec(1))
3725 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3726 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3727 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3729 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3732 ! Remaining derivatives of this turn contribution
3734 a_temp(1,1)=aggi(l,1)
3735 a_temp(1,2)=aggi(l,2)
3736 a_temp(2,1)=aggi(l,3)
3737 a_temp(2,2)=aggi(l,4)
3738 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3739 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3740 s1=scalar2(b1(1,iti2),auxvec(1))
3741 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3742 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3743 s2=scalar2(b1(1,iti1),auxvec(1))
3744 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3745 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3746 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3747 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3748 a_temp(1,1)=aggi1(l,1)
3749 a_temp(1,2)=aggi1(l,2)
3750 a_temp(2,1)=aggi1(l,3)
3751 a_temp(2,2)=aggi1(l,4)
3752 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3753 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3754 s1=scalar2(b1(1,iti2),auxvec(1))
3755 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3756 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3757 s2=scalar2(b1(1,iti1),auxvec(1))
3758 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3759 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3760 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3761 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3762 a_temp(1,1)=aggj(l,1)
3763 a_temp(1,2)=aggj(l,2)
3764 a_temp(2,1)=aggj(l,3)
3765 a_temp(2,2)=aggj(l,4)
3766 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3767 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3768 s1=scalar2(b1(1,iti2),auxvec(1))
3769 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3770 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3771 s2=scalar2(b1(1,iti1),auxvec(1))
3772 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3773 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3774 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3775 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3776 a_temp(1,1)=aggj1(l,1)
3777 a_temp(1,2)=aggj1(l,2)
3778 a_temp(2,1)=aggj1(l,3)
3779 a_temp(2,2)=aggj1(l,4)
3780 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3781 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3782 s1=scalar2(b1(1,iti2),auxvec(1))
3783 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3784 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3785 s2=scalar2(b1(1,iti1),auxvec(1))
3786 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3787 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3788 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3789 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3790 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3793 end subroutine eturn4
3794 !-----------------------------------------------------------------------------
3795 subroutine unormderiv(u,ugrad,unorm,ungrad)
3796 ! This subroutine computes the derivatives of a normalized vector u, given
3797 ! the derivatives computed without normalization conditions, ugrad. Returns
3800 real(kind=8),dimension(3) :: u,vec
3801 real(kind=8),dimension(3,3) ::ugrad,ungrad
3802 real(kind=8) :: unorm !,scalar
3804 ! write (2,*) 'ugrad',ugrad
3807 vec(i)=scalar(ugrad(1,i),u(1))
3809 ! write (2,*) 'vec',vec
3812 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3815 ! write (2,*) 'ungrad',ungrad
3817 end subroutine unormderiv
3818 !-----------------------------------------------------------------------------
3819 subroutine escp_soft_sphere(evdw2,evdw2_14)
3821 ! This subroutine calculates the excluded-volume interaction energy between
3822 ! peptide-group centers and side chains and its gradient in virtual-bond and
3823 ! side-chain vectors.
3825 ! implicit real*8 (a-h,o-z)
3826 ! include 'DIMENSIONS'
3827 ! include 'COMMON.GEO'
3828 ! include 'COMMON.VAR'
3829 ! include 'COMMON.LOCAL'
3830 ! include 'COMMON.CHAIN'
3831 ! include 'COMMON.DERIV'
3832 ! include 'COMMON.INTERACT'
3833 ! include 'COMMON.FFIELD'
3834 ! include 'COMMON.IOUNITS'
3835 ! include 'COMMON.CONTROL'
3836 real(kind=8),dimension(3) :: ggg
3838 integer :: i,iint,j,k,iteli,itypj
3839 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
3840 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
3845 !d print '(a)','Enter ESCP'
3846 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3847 do i=iatscp_s,iatscp_e
3848 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3850 xi=0.5D0*(c(1,i)+c(1,i+1))
3851 yi=0.5D0*(c(2,i)+c(2,i+1))
3852 zi=0.5D0*(c(3,i)+c(3,i+1))
3854 do iint=1,nscp_gr(i)
3856 do j=iscpstart(i,iint),iscpend(i,iint)
3857 if (itype(j).eq.ntyp1) cycle
3858 itypj=iabs(itype(j))
3859 ! Uncomment following three lines for SC-p interactions
3863 ! Uncomment following three lines for Ca-p interactions
3867 rij=xj*xj+yj*yj+zj*zj
3870 if (rij.lt.r0ijsq) then
3871 evdwij=0.25d0*(rij-r0ijsq)**2
3879 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
3884 !grad if (j.lt.i) then
3885 !d write (iout,*) 'j<i'
3886 ! Uncomment following three lines for SC-p interactions
3888 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3891 !d write (iout,*) 'j>i'
3893 !grad ggg(k)=-ggg(k)
3894 ! Uncomment following line for SC-p interactions
3895 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3899 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3901 !grad kstart=min0(i+1,j)
3902 !grad kend=max0(i-1,j-1)
3903 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3904 !d write (iout,*) ggg(1),ggg(2),ggg(3)
3905 !grad do k=kstart,kend
3907 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3911 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3912 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3919 end subroutine escp_soft_sphere
3920 !-----------------------------------------------------------------------------
3921 subroutine escp(evdw2,evdw2_14)
3923 ! This subroutine calculates the excluded-volume interaction energy between
3924 ! peptide-group centers and side chains and its gradient in virtual-bond and
3925 ! side-chain vectors.
3927 ! implicit real*8 (a-h,o-z)
3928 ! include 'DIMENSIONS'
3929 ! include 'COMMON.GEO'
3930 ! include 'COMMON.VAR'
3931 ! include 'COMMON.LOCAL'
3932 ! include 'COMMON.CHAIN'
3933 ! include 'COMMON.DERIV'
3934 ! include 'COMMON.INTERACT'
3935 ! include 'COMMON.FFIELD'
3936 ! include 'COMMON.IOUNITS'
3937 ! include 'COMMON.CONTROL'
3938 real(kind=8),dimension(3) :: ggg
3940 integer :: i,iint,j,k,iteli,itypj
3941 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
3946 !d print '(a)','Enter ESCP'
3947 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3948 do i=iatscp_s,iatscp_e
3949 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3951 xi=0.5D0*(c(1,i)+c(1,i+1))
3952 yi=0.5D0*(c(2,i)+c(2,i+1))
3953 zi=0.5D0*(c(3,i)+c(3,i+1))
3955 do iint=1,nscp_gr(i)
3957 do j=iscpstart(i,iint),iscpend(i,iint)
3958 itypj=iabs(itype(j))
3959 if (itypj.eq.ntyp1) cycle
3960 ! Uncomment following three lines for SC-p interactions
3964 ! Uncomment following three lines for Ca-p interactions
3968 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3970 e1=fac*fac*aad(itypj,iteli)
3971 e2=fac*bad(itypj,iteli)
3972 if (iabs(j-i) .le. 2) then
3975 evdw2_14=evdw2_14+e1+e2
3979 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
3980 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
3981 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3984 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
3986 fac=-(evdwij+e1)*rrij
3990 !grad if (j.lt.i) then
3991 !d write (iout,*) 'j<i'
3992 ! Uncomment following three lines for SC-p interactions
3994 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3997 !d write (iout,*) 'j>i'
3999 !grad ggg(k)=-ggg(k)
4000 ! Uncomment following line for SC-p interactions
4001 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4002 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4006 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4008 !grad kstart=min0(i+1,j)
4009 !grad kend=max0(i-1,j-1)
4010 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4011 !d write (iout,*) ggg(1),ggg(2),ggg(3)
4012 !grad do k=kstart,kend
4014 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4018 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4019 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4027 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4028 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4029 gradx_scp(j,i)=expon*gradx_scp(j,i)
4032 !******************************************************************************
4036 ! To save time the factor EXPON has been extracted from ALL components
4037 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
4040 !******************************************************************************
4043 !-----------------------------------------------------------------------------
4044 subroutine edis(ehpb)
4046 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4048 ! implicit real*8 (a-h,o-z)
4049 ! include 'DIMENSIONS'
4050 ! include 'COMMON.SBRIDGE'
4051 ! include 'COMMON.CHAIN'
4052 ! include 'COMMON.DERIV'
4053 ! include 'COMMON.VAR'
4054 ! include 'COMMON.INTERACT'
4055 ! include 'COMMON.IOUNITS'
4056 real(kind=8),dimension(3) :: ggg
4058 integer :: i,j,ii,jj,iii,jjj,k
4059 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
4062 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4063 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
4064 if (link_end.eq.0) return
4065 do i=link_start,link_end
4066 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4067 ! CA-CA distance used in regularization of structure.
4070 ! iii and jjj point to the residues for which the distance is assigned.
4071 if (ii.gt.nres) then
4078 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4079 ! & dhpb(i),dhpb1(i),forcon(i)
4080 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
4081 ! distance and angle dependent SS bond potential.
4082 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4083 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4084 if (.not.dyn_ss .and. i.le.nss) then
4085 ! 15/02/13 CC dynamic SSbond - additional check
4086 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. &
4087 iabs(itype(jjj)).eq.1) then
4088 call ssbond_ene(iii,jjj,eij)
4090 !d write (iout,*) "eij",eij
4093 ! Calculate the distance between the two points and its difference from the
4097 ! Get the force constant corresponding to this distance.
4099 ! Calculate the contribution to energy.
4100 ehpb=ehpb+waga*rdis*rdis
4102 ! Evaluate gradient.
4105 !d print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4106 !d & ' waga=',waga,' fac=',fac
4108 ggg(j)=fac*(c(j,jj)-c(j,ii))
4110 !d print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4111 ! If this is a SC-SC distance, we need to calculate the contributions to the
4112 ! Cartesian gradient in the SC vectors (ghpbx).
4115 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4116 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4119 !grad do j=iii,jjj-1
4121 !grad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4125 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4126 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4133 !-----------------------------------------------------------------------------
4134 subroutine ssbond_ene(i,j,eij)
4136 ! Calculate the distance and angle dependent SS-bond potential energy
4137 ! using a free-energy function derived based on RHF/6-31G** ab initio
4138 ! calculations of diethyl disulfide.
4140 ! A. Liwo and U. Kozlowska, 11/24/03
4142 ! implicit real*8 (a-h,o-z)
4143 ! include 'DIMENSIONS'
4144 ! include 'COMMON.SBRIDGE'
4145 ! include 'COMMON.CHAIN'
4146 ! include 'COMMON.DERIV'
4147 ! include 'COMMON.LOCAL'
4148 ! include 'COMMON.INTERACT'
4149 ! include 'COMMON.VAR'
4150 ! include 'COMMON.IOUNITS'
4151 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
4153 integer :: i,j,itypi,itypj,k
4154 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
4155 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
4156 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
4159 itypi=iabs(itype(i))
4163 dxi=dc_norm(1,nres+i)
4164 dyi=dc_norm(2,nres+i)
4165 dzi=dc_norm(3,nres+i)
4166 ! dsci_inv=dsc_inv(itypi)
4167 dsci_inv=vbld_inv(nres+i)
4168 itypj=iabs(itype(j))
4169 ! dscj_inv=dsc_inv(itypj)
4170 dscj_inv=vbld_inv(nres+j)
4174 dxj=dc_norm(1,nres+j)
4175 dyj=dc_norm(2,nres+j)
4176 dzj=dc_norm(3,nres+j)
4177 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4182 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4183 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4184 om12=dxi*dxj+dyi*dyj+dzi*dzj
4186 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4187 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4193 deltat12=om2-om1+2.0d0
4195 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
4196 +akct*deltad*deltat12 &
4197 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4198 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4199 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4200 ! & " deltat12",deltat12," eij",eij
4201 ed=2*akcm*deltad+akct*deltat12
4203 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4204 eom1=-2*akth*deltat1-pom1-om2*pom2
4205 eom2= 2*akth*deltat2+pom1-om1*pom2
4208 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4209 ghpbx(k,i)=ghpbx(k,i)-ggk &
4210 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
4211 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4212 ghpbx(k,j)=ghpbx(k,j)+ggk &
4213 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
4214 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4215 ghpbc(k,i)=ghpbc(k,i)-ggk
4216 ghpbc(k,j)=ghpbc(k,j)+ggk
4219 ! Calculate the components of the gradient in DC and X
4223 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4227 end subroutine ssbond_ene
4228 !-----------------------------------------------------------------------------
4229 subroutine ebond(estr)
4231 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4233 ! implicit real*8 (a-h,o-z)
4234 ! include 'DIMENSIONS'
4235 ! include 'COMMON.LOCAL'
4236 ! include 'COMMON.GEO'
4237 ! include 'COMMON.INTERACT'
4238 ! include 'COMMON.DERIV'
4239 ! include 'COMMON.VAR'
4240 ! include 'COMMON.CHAIN'
4241 ! include 'COMMON.IOUNITS'
4242 ! include 'COMMON.NAMES'
4243 ! include 'COMMON.FFIELD'
4244 ! include 'COMMON.CONTROL'
4245 ! include 'COMMON.SETUP'
4246 real(kind=8),dimension(3) :: u,ud
4248 integer :: i,j,iti,nbi,k
4249 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
4254 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
4255 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
4257 do i=ibondp_start,ibondp_end
4258 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4259 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4260 !C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4262 !C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
4263 !C *dc(j,i-1)/vbld(i)
4265 !C if (energy_dec) write(iout,*) &
4266 !C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4267 diff = vbld(i)-vbldpDUM
4269 diff = vbld(i)-vbldp0
4271 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
4272 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4275 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4277 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4280 estr=0.5d0*AKP*estr+estr1
4282 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4284 do i=ibond_start,ibond_end
4286 if (iti.ne.10 .and. iti.ne.ntyp1) then
4289 diff=vbld(i+nres)-vbldsc0(1,iti)
4290 if (energy_dec) write (iout,*) &
4291 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
4292 AKSC(1,iti),AKSC(1,iti)*diff*diff
4293 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4295 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4299 diff=vbld(i+nres)-vbldsc0(j,iti)
4300 ud(j)=aksc(j,iti)*diff
4301 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4315 uprod2=uprod2*u(k)*u(k)
4319 usumsqder=usumsqder+ud(j)*uprod2
4321 estr=estr+uprod/usum
4323 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4329 end subroutine ebond
4331 !-----------------------------------------------------------------------------
4332 subroutine ebend(etheta)
4334 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4335 ! angles gamma and its derivatives in consecutive thetas and gammas.
4338 ! implicit real*8 (a-h,o-z)
4339 ! include 'DIMENSIONS'
4340 ! include 'COMMON.LOCAL'
4341 ! include 'COMMON.GEO'
4342 ! include 'COMMON.INTERACT'
4343 ! include 'COMMON.DERIV'
4344 ! include 'COMMON.VAR'
4345 ! include 'COMMON.CHAIN'
4346 ! include 'COMMON.IOUNITS'
4347 ! include 'COMMON.NAMES'
4348 ! include 'COMMON.FFIELD'
4349 ! include 'COMMON.CONTROL'
4350 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
4351 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4352 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
4354 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
4355 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4356 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4358 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
4360 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
4361 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
4362 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
4363 real(kind=8),dimension(2) :: y,z
4366 ! time11=dexp(-2*time)
4369 ! write (*,'(a,i2)') 'EBEND ICG=',icg
4370 do i=ithet_start,ithet_end
4371 if (itype(i-1).eq.ntyp1) cycle
4372 ! Zero the energy function and its derivative at 0 or pi.
4373 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4375 ichir1=isign(1,itype(i-2))
4376 ichir2=isign(1,itype(i))
4377 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4378 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4379 if (itype(i-1).eq.10) then
4380 itype1=isign(10,itype(i-2))
4381 ichir11=isign(1,itype(i-2))
4382 ichir12=isign(1,itype(i-2))
4383 itype2=isign(10,itype(i))
4384 ichir21=isign(1,itype(i))
4385 ichir22=isign(1,itype(i))
4388 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4391 if (phii.ne.phii) phii=150.0
4401 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4404 if (phii1.ne.phii1) phii1=150.0
4416 ! Calculate the "mean" value of theta from the part of the distribution
4417 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4418 ! In following comments this theta will be referred to as t_c.
4419 thet_pred_mean=0.0d0
4421 athetk=athet(k,it,ichir1,ichir2)
4422 bthetk=bthet(k,it,ichir1,ichir2)
4424 athetk=athet(k,itype1,ichir11,ichir12)
4425 bthetk=bthet(k,itype2,ichir21,ichir22)
4427 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4429 dthett=thet_pred_mean*ssd
4430 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4431 ! Derivatives of the "mean" values in gamma1 and gamma2.
4432 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
4433 +athet(2,it,ichir1,ichir2)*y(1))*ss
4434 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
4435 +bthet(2,it,ichir1,ichir2)*z(1))*ss
4437 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
4438 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
4439 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
4440 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4442 if (theta(i).gt.pi-delta) then
4443 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
4445 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4446 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4447 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
4449 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
4451 else if (theta(i).lt.delta) then
4452 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4453 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4454 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
4456 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4457 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
4460 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
4463 etheta=etheta+ethetai
4464 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
4466 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4467 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4468 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4470 ! Ufff.... We've done all this!!!
4472 end subroutine ebend
4473 !-----------------------------------------------------------------------------
4474 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
4477 ! implicit real*8 (a-h,o-z)
4478 ! include 'DIMENSIONS'
4479 ! include 'COMMON.LOCAL'
4480 ! include 'COMMON.IOUNITS'
4481 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
4482 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4483 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
4485 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
4487 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
4488 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4489 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4491 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
4492 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
4494 ! Calculate the contributions to both Gaussian lobes.
4495 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4496 ! The "polynomial part" of the "standard deviation" of this part of
4500 sig=sig*thet_pred_mean+polthet(j,it)
4502 ! Derivative of the "interior part" of the "standard deviation of the"
4503 ! gamma-dependent Gaussian lobe in t_c.
4504 sigtc=3*polthet(3,it)
4506 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4509 ! Set the parameters of both Gaussian lobes of the distribution.
4510 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4511 fac=sig*sig+sigc0(it)
4514 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4515 sigsqtc=-4.0D0*sigcsq*sigtc
4516 ! print *,i,sig,sigtc,sigsqtc
4517 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
4518 sigtc=-sigtc/(fac*fac)
4519 ! Following variable is sigma(t_c)**(-2)
4520 sigcsq=sigcsq*sigcsq
4522 sig0inv=1.0D0/sig0i**2
4523 delthec=thetai-thet_pred_mean
4524 delthe0=thetai-theta0i
4525 term1=-0.5D0*sigcsq*delthec*delthec
4526 term2=-0.5D0*sig0inv*delthe0*delthe0
4527 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4528 ! NaNs in taking the logarithm. We extract the largest exponent which is added
4529 ! to the energy (this being the log of the distribution) at the end of energy
4530 ! term evaluation for this virtual-bond angle.
4531 if (term1.gt.term2) then
4533 term2=dexp(term2-termm)
4537 term1=dexp(term1-termm)
4540 ! The ratio between the gamma-independent and gamma-dependent lobes of
4541 ! the distribution is a Gaussian function of thet_pred_mean too.
4542 diffak=gthet(2,it)-thet_pred_mean
4543 ratak=diffak/gthet(3,it)**2
4544 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4545 ! Let's differentiate it in thet_pred_mean NOW.
4547 ! Now put together the distribution terms to make complete distribution.
4548 termexp=term1+ak*term2
4549 termpre=sigc+ak*sig0i
4550 ! Contribution of the bending energy from this theta is just the -log of
4551 ! the sum of the contributions from the two lobes and the pre-exponential
4552 ! factor. Simple enough, isn't it?
4553 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4554 ! NOW the derivatives!!!
4555 ! 6/6/97 Take into account the deformation.
4556 E_theta=(delthec*sigcsq*term1 &
4557 +ak*delthe0*sig0inv*term2)/termexp
4558 E_tc=((sigtc+aktc*sig0i)/termpre &
4559 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
4560 aktc*term2)/termexp)
4562 end subroutine theteng
4564 !-----------------------------------------------------------------------------
4565 subroutine ebend(etheta)
4567 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4568 ! angles gamma and its derivatives in consecutive thetas and gammas.
4569 ! ab initio-derived potentials from
4570 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4572 ! implicit real*8 (a-h,o-z)
4573 ! include 'DIMENSIONS'
4574 ! include 'COMMON.LOCAL'
4575 ! include 'COMMON.GEO'
4576 ! include 'COMMON.INTERACT'
4577 ! include 'COMMON.DERIV'
4578 ! include 'COMMON.VAR'
4579 ! include 'COMMON.CHAIN'
4580 ! include 'COMMON.IOUNITS'
4581 ! include 'COMMON.NAMES'
4582 ! include 'COMMON.FFIELD'
4583 ! include 'COMMON.CONTROL'
4584 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
4585 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
4586 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
4587 logical :: lprn=.false., lprn1=.false.
4589 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
4590 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
4591 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl
4594 do i=ithet_start,ithet_end
4595 if (itype(i-1).eq.ntyp1) cycle
4596 if (itype(i-2).eq.ntyp1.or.itype(i).eq.ntyp1) cycle
4597 if (iabs(itype(i+1)).eq.20) iblock=2
4598 if (iabs(itype(i+1)).ne.20) iblock=1
4602 theti2=0.5d0*theta(i)
4603 ityp2=ithetyp((itype(i-1)))
4605 coskt(k)=dcos(k*theti2)
4606 sinkt(k)=dsin(k*theti2)
4608 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4611 if (phii.ne.phii) phii=150.0
4615 ityp1=ithetyp((itype(i-2)))
4616 ! propagation of chirality for glycine type
4618 cosph1(k)=dcos(k*phii)
4619 sinph1(k)=dsin(k*phii)
4623 ityp1=ithetyp(itype(i-2))
4629 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4632 if (phii1.ne.phii1) phii1=150.0
4637 ityp3=ithetyp((itype(i)))
4639 cosph2(k)=dcos(k*phii1)
4640 sinph2(k)=dsin(k*phii1)
4644 ityp3=ithetyp(itype(i))
4650 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4653 ccl=cosph1(l)*cosph2(k-l)
4654 ssl=sinph1(l)*sinph2(k-l)
4655 scl=sinph1(l)*cosph2(k-l)
4656 csl=cosph1(l)*sinph2(k-l)
4657 cosph1ph2(l,k)=ccl-ssl
4658 cosph1ph2(k,l)=ccl+ssl
4659 sinph1ph2(l,k)=scl+csl
4660 sinph1ph2(k,l)=scl-csl
4664 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
4665 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4666 write (iout,*) "coskt and sinkt"
4668 write (iout,*) k,coskt(k),sinkt(k)
4672 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4673 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
4676 write (iout,*) "k",k,&
4677 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
4681 write (iout,*) "cosph and sinph"
4683 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4685 write (iout,*) "cosph1ph2 and sinph2ph2"
4688 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
4689 sinph1ph2(l,k),sinph1ph2(k,l)
4692 write(iout,*) "ethetai",ethetai
4696 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
4697 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
4698 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
4699 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4700 ethetai=ethetai+sinkt(m)*aux
4701 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4702 dephii=dephii+k*sinkt(m)* &
4703 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
4704 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4705 dephii1=dephii1+k*sinkt(m)* &
4706 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
4707 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4709 write (iout,*) "m",m," k",k," bbthet", &
4710 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
4711 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
4712 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
4713 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4717 write(iout,*) "ethetai",ethetai
4721 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
4722 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
4723 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
4724 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4725 ethetai=ethetai+sinkt(m)*aux
4726 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4727 dephii=dephii+l*sinkt(m)* &
4728 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
4729 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
4730 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
4731 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4732 dephii1=dephii1+(k-l)*sinkt(m)* &
4733 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
4734 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
4735 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
4736 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4738 write (iout,*) "m",m," k",k," l",l," ffthet",&
4739 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
4740 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
4741 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
4742 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
4744 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
4745 cosph1ph2(k,l)*sinkt(m),&
4746 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4754 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
4755 i,theta(i)*rad2deg,phii*rad2deg,&
4756 phii1*rad2deg,ethetai
4758 etheta=etheta+ethetai
4759 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
4761 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4762 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4763 gloc(nphi+i-2,icg)=wang*dethetai
4766 end subroutine ebend
4769 !-----------------------------------------------------------------------------
4770 subroutine esc(escloc)
4771 ! Calculate the local energy of a side chain and its derivatives in the
4772 ! corresponding virtual-bond valence angles THETA and the spherical angles
4776 ! implicit real*8 (a-h,o-z)
4777 ! include 'DIMENSIONS'
4778 ! include 'COMMON.GEO'
4779 ! include 'COMMON.LOCAL'
4780 ! include 'COMMON.VAR'
4781 ! include 'COMMON.INTERACT'
4782 ! include 'COMMON.DERIV'
4783 ! include 'COMMON.CHAIN'
4784 ! include 'COMMON.IOUNITS'
4785 ! include 'COMMON.NAMES'
4786 ! include 'COMMON.FFIELD'
4787 ! include 'COMMON.CONTROL'
4788 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
4789 ddersc0,ddummy,xtemp,temp
4790 !el real(kind=8) :: time11,time12,time112,theti
4791 real(kind=8) :: escloc,delta
4792 !el integer :: it,nlobit
4793 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4796 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
4797 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
4800 ! write (iout,'(a)') 'ESC'
4801 do i=loc_start,loc_end
4803 if (it.eq.ntyp1) cycle
4804 if (it.eq.10) goto 1
4805 nlobit=nlob(iabs(it))
4806 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
4807 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4808 theti=theta(i+1)-pipol
4813 if (x(2).gt.pi-delta) then
4817 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4819 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4820 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
4822 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
4823 ddersc0(1),dersc(1))
4824 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
4825 ddersc0(3),dersc(3))
4827 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4829 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4830 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
4831 dersc0(2),esclocbi,dersc02)
4832 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
4834 call splinthet(x(2),0.5d0*delta,ss,ssd)
4839 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4841 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4842 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4844 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4846 ! write (iout,*) escloci
4847 else if (x(2).lt.delta) then
4851 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4853 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4854 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
4856 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
4857 ddersc0(1),dersc(1))
4858 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
4859 ddersc0(3),dersc(3))
4861 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4863 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4864 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
4865 dersc0(2),esclocbi,dersc02)
4866 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
4871 call splinthet(x(2),0.5d0*delta,ss,ssd)
4873 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4875 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4876 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4878 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4879 ! write (iout,*) escloci
4881 call enesc(x,escloci,dersc,ddummy,.false.)
4884 escloc=escloc+escloci
4885 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
4887 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4889 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
4891 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4892 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4897 !-----------------------------------------------------------------------------
4898 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4901 ! implicit real*8 (a-h,o-z)
4902 ! include 'DIMENSIONS'
4903 ! include 'COMMON.GEO'
4904 ! include 'COMMON.LOCAL'
4905 ! include 'COMMON.IOUNITS'
4906 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4907 real(kind=8),dimension(3) :: x,z,dersc,ddersc
4908 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
4909 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
4910 real(kind=8) :: escloci
4913 integer :: j,iii,l,k !el,it,nlobit
4914 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
4915 !el time11,time12,time112
4916 ! write (iout,*) 'it=',it,' nlobit=',nlobit
4920 if (mixed) ddersc(j)=0.0d0
4924 ! Because of periodicity of the dependence of the SC energy in omega we have
4925 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4926 ! To avoid underflows, first compute & store the exponents.
4934 z(k)=x(k)-censc(k,j,it)
4939 Axk=Axk+gaussc(l,k,j,it)*z(l)
4945 expfac=expfac+Ax(k,j,iii)*z(k)
4953 ! As in the case of ebend, we want to avoid underflows in exponentiation and
4954 ! subsequent NaNs and INFs in energy calculation.
4955 ! Find the largest exponent
4959 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4963 !d print *,'it=',it,' emin=',emin
4965 ! Compute the contribution to SC energy and derivatives
4970 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
4971 if(adexp.ne.adexp) adexp=1.0
4974 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4976 !d print *,'j=',j,' expfac=',expfac
4977 escloc_i=escloc_i+expfac
4979 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4983 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
4984 +gaussc(k,2,j,it))*expfac
4991 dersc(1)=dersc(1)/cos(theti)**2
4992 ddersc(1)=ddersc(1)/cos(theti)**2
4995 escloci=-(dlog(escloc_i)-emin)
4997 dersc(j)=dersc(j)/escloc_i
5001 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5005 end subroutine enesc
5006 !-----------------------------------------------------------------------------
5007 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5010 ! implicit real*8 (a-h,o-z)
5011 ! include 'DIMENSIONS'
5012 ! include 'COMMON.GEO'
5013 ! include 'COMMON.LOCAL'
5014 ! include 'COMMON.IOUNITS'
5015 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5016 real(kind=8),dimension(3) :: x,z,dersc
5017 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
5018 real(kind=8),dimension(nlobit) :: contr !(maxlob)
5019 real(kind=8) :: escloci,dersc12,emin
5022 integer :: j,k,l !el,it,nlobit
5023 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
5033 z(k)=x(k)-censc(k,j,it)
5039 Axk=Axk+gaussc(l,k,j,it)*z(l)
5045 expfac=expfac+Ax(k,j)*z(k)
5050 ! As in the case of ebend, we want to avoid underflows in exponentiation and
5051 ! subsequent NaNs and INFs in energy calculation.
5052 ! Find the largest exponent
5055 if (emin.gt.contr(j)) emin=contr(j)
5059 ! Compute the contribution to SC energy and derivatives
5063 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5064 escloc_i=escloc_i+expfac
5066 dersc(k)=dersc(k)+Ax(k,j)*expfac
5068 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
5069 +gaussc(1,2,j,it))*expfac
5073 dersc(1)=dersc(1)/cos(theti)**2
5074 dersc12=dersc12/cos(theti)**2
5075 escloci=-(dlog(escloc_i)-emin)
5077 dersc(j)=dersc(j)/escloc_i
5079 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5081 end subroutine enesc_bound
5083 !-----------------------------------------------------------------------------
5084 subroutine esc(escloc)
5085 ! Calculate the local energy of a side chain and its derivatives in the
5086 ! corresponding virtual-bond valence angles THETA and the spherical angles
5087 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
5088 ! added by Urszula Kozlowska. 07/11/2007
5091 ! implicit real*8 (a-h,o-z)
5092 ! include 'DIMENSIONS'
5093 ! include 'COMMON.GEO'
5094 ! include 'COMMON.LOCAL'
5095 ! include 'COMMON.VAR'
5096 ! include 'COMMON.SCROT'
5097 ! include 'COMMON.INTERACT'
5098 ! include 'COMMON.DERIV'
5099 ! include 'COMMON.CHAIN'
5100 ! include 'COMMON.IOUNITS'
5101 ! include 'COMMON.NAMES'
5102 ! include 'COMMON.FFIELD'
5103 ! include 'COMMON.CONTROL'
5104 ! include 'COMMON.VECTORS'
5105 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
5106 real(kind=8),dimension(65) :: x
5107 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
5108 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
5109 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
5110 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
5111 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
5113 integer :: i,j,k !el,it,nlobit
5114 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
5115 !el real(kind=8) :: time11,time12,time112,theti
5116 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5117 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
5118 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
5119 sumene1x,sumene2x,sumene3x,sumene4x,&
5120 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
5123 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
5124 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
5127 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
5131 do i=loc_start,loc_end
5132 if (itype(i).eq.ntyp1) cycle
5133 costtab(i+1) =dcos(theta(i+1))
5134 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5135 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5136 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5137 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5138 cosfac=dsqrt(cosfac2)
5139 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5140 sinfac=dsqrt(sinfac2)
5142 if (it.eq.10) goto 1
5144 ! Compute the axes of tghe local cartesian coordinates system; store in
5145 ! x_prime, y_prime and z_prime
5152 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5153 ! & dc_norm(3,i+nres)
5155 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5156 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5159 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5162 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
5163 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
5164 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
5165 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5166 ! & " xy",scalar(x_prime(1),y_prime(1)),
5167 ! & " xz",scalar(x_prime(1),z_prime(1)),
5168 ! & " yy",scalar(y_prime(1),y_prime(1)),
5169 ! & " yz",scalar(y_prime(1),z_prime(1)),
5170 ! & " zz",scalar(z_prime(1),z_prime(1))
5172 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5173 ! to local coordinate system. Store in xx, yy, zz.
5179 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5180 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5181 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5188 ! Compute the energy of the ith side cbain
5190 ! write (2,*) "xx",xx," yy",yy," zz",zz
5193 x(j) = sc_parmin(j,it)
5196 !c diagnostics - remove later
5198 yy1 = dsin(alph(2))*dcos(omeg(2))
5199 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5200 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
5201 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
5203 !," --- ", xx_w,yy_w,zz_w
5206 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
5207 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
5209 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
5210 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
5212 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
5213 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
5214 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
5215 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
5216 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
5218 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
5219 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
5220 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
5221 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
5222 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
5224 dsc_i = 0.743d0+x(61)
5226 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5227 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5228 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5229 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5230 s1=(1+x(63))/(0.1d0 + dscp1)
5231 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5232 s2=(1+x(65))/(0.1d0 + dscp2)
5233 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5234 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
5235 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5236 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5238 ! & dscp1,dscp2,sumene
5239 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5240 escloc = escloc + sumene
5241 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5246 ! This section to check the numerical derivatives of the energy of ith side
5247 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5248 ! #define DEBUG in the code to turn it on.
5250 write (2,*) "sumene =",sumene
5254 write (2,*) xx,yy,zz
5255 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5256 de_dxx_num=(sumenep-sumene)/aincr
5258 write (2,*) "xx+ sumene from enesc=",sumenep
5261 write (2,*) xx,yy,zz
5262 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5263 de_dyy_num=(sumenep-sumene)/aincr
5265 write (2,*) "yy+ sumene from enesc=",sumenep
5268 write (2,*) xx,yy,zz
5269 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5270 de_dzz_num=(sumenep-sumene)/aincr
5272 write (2,*) "zz+ sumene from enesc=",sumenep
5273 costsave=cost2tab(i+1)
5274 sintsave=sint2tab(i+1)
5275 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5276 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5277 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5278 de_dt_num=(sumenep-sumene)/aincr
5279 write (2,*) " t+ sumene from enesc=",sumenep
5280 cost2tab(i+1)=costsave
5281 sint2tab(i+1)=sintsave
5282 ! End of diagnostics section.
5285 ! Compute the gradient of esc
5287 ! zz=zz*dsign(1.0,dfloat(itype(i)))
5288 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5289 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5290 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5291 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5292 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5293 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5294 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5295 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5296 pom1=(sumene3*sint2tab(i+1)+sumene1) &
5297 *(pom_s1/dscp1+pom_s16*dscp1**4)
5298 pom2=(sumene4*cost2tab(i+1)+sumene2) &
5299 *(pom_s2/dscp2+pom_s26*dscp2**4)
5300 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5301 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
5302 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
5304 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5305 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
5306 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
5308 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
5309 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
5312 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5315 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5316 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
5317 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
5319 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5320 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
5321 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
5322 +x(59)*zz**2 +x(60)*xx*zz
5323 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
5324 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
5327 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5330 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
5331 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
5332 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
5333 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
5334 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
5335 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
5336 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
5337 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5339 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5342 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
5343 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
5344 +pom1*pom_dt1+pom2*pom_dt2
5346 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5350 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5351 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5352 cosfac2xx=cosfac2*xx
5353 sinfac2yy=sinfac2*yy
5355 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
5357 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
5359 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5360 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5361 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5362 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5363 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5364 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5365 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5366 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5367 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5368 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5372 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
5373 *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5374 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
5375 *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5378 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5379 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5380 dZZ_XYZ(k)=vbld_inv(i+nres)* &
5381 (z_prime(k)-zz*dC_norm(k,i+nres))
5383 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5384 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5388 dXX_Ctab(k,i)=dXX_Ci(k)
5389 dXX_C1tab(k,i)=dXX_Ci1(k)
5390 dYY_Ctab(k,i)=dYY_Ci(k)
5391 dYY_C1tab(k,i)=dYY_Ci1(k)
5392 dZZ_Ctab(k,i)=dZZ_Ci(k)
5393 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5394 dXX_XYZtab(k,i)=dXX_XYZ(k)
5395 dYY_XYZtab(k,i)=dYY_XYZ(k)
5396 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5400 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5401 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5402 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5403 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
5404 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5406 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5407 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5408 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
5409 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5410 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
5411 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5412 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
5413 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5415 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5416 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5418 ! to check gradient call subroutine check_grad
5424 !-----------------------------------------------------------------------------
5425 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
5427 real(kind=8),dimension(65) :: x
5428 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
5429 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5431 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
5432 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
5434 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
5435 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
5437 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
5438 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
5439 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
5440 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
5441 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
5443 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
5444 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
5445 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
5446 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
5447 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
5449 dsc_i = 0.743d0+x(61)
5451 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5452 *(xx*cost2+yy*sint2))
5453 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5454 *(xx*cost2-yy*sint2))
5455 s1=(1+x(63))/(0.1d0 + dscp1)
5456 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5457 s2=(1+x(65))/(0.1d0 + dscp2)
5458 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5459 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
5460 + (sumene4*cost2 +sumene2)*(s2+s2_6)
5465 !-----------------------------------------------------------------------------
5466 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5468 ! This procedure calculates two-body contact function g(rij) and its derivative:
5471 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5474 ! where x=(rij-r0ij)/delta
5476 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5479 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
5480 real(kind=8) :: x,x2,x4,delta
5484 if (x.lt.-1.0D0) then
5487 else if (x.le.1.0D0) then
5490 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5491 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5497 end subroutine gcont
5498 !-----------------------------------------------------------------------------
5499 subroutine splinthet(theti,delta,ss,ssder)
5500 ! implicit real*8 (a-h,o-z)
5501 ! include 'DIMENSIONS'
5502 ! include 'COMMON.VAR'
5503 ! include 'COMMON.GEO'
5504 real(kind=8) :: theti,delta,ss,ssder
5505 real(kind=8) :: thetup,thetlow
5508 if (theti.gt.pipol) then
5509 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5511 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5515 end subroutine splinthet
5516 !-----------------------------------------------------------------------------
5517 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5519 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
5520 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
5521 a1=fprim0*delta/(f1-f0)
5527 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5528 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5530 end subroutine spline1
5531 !-----------------------------------------------------------------------------
5532 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5534 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
5535 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
5540 a2=3*(f1x-f0x)-2*fprim0x*delta
5541 a3=fprim0x*delta-2*(f1x-f0x)
5542 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5544 end subroutine spline2
5545 !-----------------------------------------------------------------------------
5547 !-----------------------------------------------------------------------------
5548 subroutine etor(etors,edihcnstr)
5549 ! implicit real*8 (a-h,o-z)
5550 ! include 'DIMENSIONS'
5551 ! include 'COMMON.VAR'
5552 ! include 'COMMON.GEO'
5553 ! include 'COMMON.LOCAL'
5554 ! include 'COMMON.TORSION'
5555 ! include 'COMMON.INTERACT'
5556 ! include 'COMMON.DERIV'
5557 ! include 'COMMON.CHAIN'
5558 ! include 'COMMON.NAMES'
5559 ! include 'COMMON.IOUNITS'
5560 ! include 'COMMON.FFIELD'
5561 ! include 'COMMON.TORCNSTR'
5562 ! include 'COMMON.CONTROL'
5563 real(kind=8) :: etors,edihcnstr
5567 real(kind=8) :: phii,fac,etors_ii
5569 ! Set lprn=.true. for debugging
5573 do i=iphi_start,iphi_end
5575 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 &
5576 .or. itype(i).eq.ntyp1) cycle
5577 itori=itortyp(itype(i-2))
5578 itori1=itortyp(itype(i-1))
5581 ! Proline-Proline pair is a special case...
5582 if (itori.eq.3 .and. itori1.eq.3) then
5583 if (phii.gt.-dwapi3) then
5585 fac=1.0D0/(1.0D0-cosphi)
5586 etorsi=v1(1,3,3)*fac
5587 etorsi=etorsi+etorsi
5588 etors=etors+etorsi-v1(1,3,3)
5589 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5590 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5593 v1ij=v1(j+1,itori,itori1)
5594 v2ij=v2(j+1,itori,itori1)
5597 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5598 if (energy_dec) etors_ii=etors_ii+ &
5599 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5600 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5604 v1ij=v1(j,itori,itori1)
5605 v2ij=v2(j,itori,itori1)
5608 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5609 if (energy_dec) etors_ii=etors_ii+ &
5610 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5611 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5614 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5617 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5618 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
5619 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5620 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5621 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5623 ! 6/20/98 - dihedral angle constraints
5626 itori=idih_constr(i)
5629 if (difi.gt.drange(i)) then
5631 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5632 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5633 else if (difi.lt.-drange(i)) then
5635 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5636 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5638 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5639 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5641 ! write (iout,*) 'edihcnstr',edihcnstr
5644 !-----------------------------------------------------------------------------
5645 subroutine etor_d(etors_d)
5646 real(kind=8) :: etors_d
5649 end subroutine etor_d
5651 !-----------------------------------------------------------------------------
5652 subroutine etor(etors,edihcnstr)
5653 ! implicit real*8 (a-h,o-z)
5654 ! include 'DIMENSIONS'
5655 ! include 'COMMON.VAR'
5656 ! include 'COMMON.GEO'
5657 ! include 'COMMON.LOCAL'
5658 ! include 'COMMON.TORSION'
5659 ! include 'COMMON.INTERACT'
5660 ! include 'COMMON.DERIV'
5661 ! include 'COMMON.CHAIN'
5662 ! include 'COMMON.NAMES'
5663 ! include 'COMMON.IOUNITS'
5664 ! include 'COMMON.FFIELD'
5665 ! include 'COMMON.TORCNSTR'
5666 ! include 'COMMON.CONTROL'
5667 real(kind=8) :: etors,edihcnstr
5670 integer :: i,j,iblock,itori,itori1
5671 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
5672 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
5673 ! Set lprn=.true. for debugging
5677 do i=iphi_start,iphi_end
5678 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
5679 .or. itype(i-3).eq.ntyp1 &
5680 .or. itype(i).eq.ntyp1) cycle
5682 if (iabs(itype(i)).eq.20) then
5687 itori=itortyp(itype(i-2))
5688 itori1=itortyp(itype(i-1))
5691 ! Regular cosine and sine terms
5692 do j=1,nterm(itori,itori1,iblock)
5693 v1ij=v1(j,itori,itori1,iblock)
5694 v2ij=v2(j,itori,itori1,iblock)
5697 etors=etors+v1ij*cosphi+v2ij*sinphi
5698 if (energy_dec) etors_ii=etors_ii+ &
5699 v1ij*cosphi+v2ij*sinphi
5700 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5704 ! E = SUM ----------------------------------- - v1
5705 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5707 cosphi=dcos(0.5d0*phii)
5708 sinphi=dsin(0.5d0*phii)
5709 do j=1,nlor(itori,itori1,iblock)
5710 vl1ij=vlor1(j,itori,itori1)
5711 vl2ij=vlor2(j,itori,itori1)
5712 vl3ij=vlor3(j,itori,itori1)
5713 pom=vl2ij*cosphi+vl3ij*sinphi
5714 pom1=1.0d0/(pom*pom+1.0d0)
5715 etors=etors+vl1ij*pom1
5716 if (energy_dec) etors_ii=etors_ii+ &
5719 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5721 ! Subtract the constant term
5722 etors=etors-v0(itori,itori1,iblock)
5723 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5724 'etor',i,etors_ii-v0(itori,itori1,iblock)
5726 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5727 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
5728 (v1(j,itori,itori1,iblock),j=1,6),&
5729 (v2(j,itori,itori1,iblock),j=1,6)
5730 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5731 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5733 ! 6/20/98 - dihedral angle constraints
5735 ! do i=1,ndih_constr
5736 do i=idihconstr_start,idihconstr_end
5737 itori=idih_constr(i)
5739 difi=pinorm(phii-phi0(i))
5740 if (difi.gt.drange(i)) then
5742 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5743 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5744 else if (difi.lt.-drange(i)) then
5746 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5747 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5751 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5752 !d & rad2deg*phi0(i), rad2deg*drange(i),
5753 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5755 !d write (iout,*) 'edihcnstr',edihcnstr
5758 !-----------------------------------------------------------------------------
5759 subroutine etor_d(etors_d)
5760 ! 6/23/01 Compute double torsional energy
5761 ! implicit real*8 (a-h,o-z)
5762 ! include 'DIMENSIONS'
5763 ! include 'COMMON.VAR'
5764 ! include 'COMMON.GEO'
5765 ! include 'COMMON.LOCAL'
5766 ! include 'COMMON.TORSION'
5767 ! include 'COMMON.INTERACT'
5768 ! include 'COMMON.DERIV'
5769 ! include 'COMMON.CHAIN'
5770 ! include 'COMMON.NAMES'
5771 ! include 'COMMON.IOUNITS'
5772 ! include 'COMMON.FFIELD'
5773 ! include 'COMMON.TORCNSTR'
5774 real(kind=8) :: etors_d,etors_d_ii
5777 integer :: i,j,k,l,itori,itori1,itori2,iblock
5778 real(kind=8) :: phii,phii1,gloci1,gloci2,&
5779 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
5780 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
5781 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
5782 ! Set lprn=.true. for debugging
5786 ! write(iout,*) "a tu??"
5787 do i=iphid_start,iphid_end
5789 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
5790 .or. itype(i-3).eq.ntyp1 &
5791 .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5792 itori=itortyp(itype(i-2))
5793 itori1=itortyp(itype(i-1))
5794 itori2=itortyp(itype(i))
5800 if (iabs(itype(i+1)).eq.20) iblock=2
5802 ! Regular cosine and sine terms
5803 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5804 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5805 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5806 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5807 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5808 cosphi1=dcos(j*phii)
5809 sinphi1=dsin(j*phii)
5810 cosphi2=dcos(j*phii1)
5811 sinphi2=dsin(j*phii1)
5812 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
5813 v2cij*cosphi2+v2sij*sinphi2
5814 if (energy_dec) etors_d_ii=etors_d_ii+ &
5815 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
5816 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5817 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5819 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5821 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5822 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5823 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5824 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5825 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5826 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5827 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5828 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5829 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
5830 v1sdij*sinphi1p2+v2sdij*sinphi1m2
5831 if (energy_dec) etors_d_ii=etors_d_ii+ &
5832 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
5833 v1sdij*sinphi1p2+v2sdij*sinphi1m2
5834 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
5835 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5836 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
5837 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5840 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5841 'etor_d',i,etors_d_ii
5842 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5843 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5846 end subroutine etor_d
5848 !-----------------------------------------------------------------------------
5849 subroutine eback_sc_corr(esccor)
5850 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
5851 ! conformational states; temporarily implemented as differences
5852 ! between UNRES torsional potentials (dependent on three types of
5853 ! residues) and the torsional potentials dependent on all 20 types
5854 ! of residues computed from AM1 energy surfaces of terminally-blocked
5855 ! amino-acid residues.
5856 ! implicit real*8 (a-h,o-z)
5857 ! include 'DIMENSIONS'
5858 ! include 'COMMON.VAR'
5859 ! include 'COMMON.GEO'
5860 ! include 'COMMON.LOCAL'
5861 ! include 'COMMON.TORSION'
5862 ! include 'COMMON.SCCOR'
5863 ! include 'COMMON.INTERACT'
5864 ! include 'COMMON.DERIV'
5865 ! include 'COMMON.CHAIN'
5866 ! include 'COMMON.NAMES'
5867 ! include 'COMMON.IOUNITS'
5868 ! include 'COMMON.FFIELD'
5869 ! include 'COMMON.CONTROL'
5870 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
5873 integer :: i,interty,j,isccori,isccori1,intertyp
5874 ! Set lprn=.true. for debugging
5877 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5879 do i=itau_start,itau_end
5880 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5882 isccori=isccortyp(itype(i-2))
5883 isccori1=isccortyp(itype(i-1))
5885 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5887 do intertyp=1,3 !intertyp
5889 !c Added 09 May 2012 (Adasko)
5890 !c Intertyp means interaction type of backbone mainchain correlation:
5891 ! 1 = SC...Ca...Ca...Ca
5892 ! 2 = Ca...Ca...Ca...SC
5893 ! 3 = SC...Ca...Ca...SCi
5895 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. &
5896 (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or. &
5897 (itype(i-1).eq.ntyp1))) &
5898 .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) &
5899 .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1) &
5900 .or.(itype(i).eq.ntyp1))) &
5901 .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. &
5902 (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. &
5903 (itype(i-3).eq.ntyp1)))) cycle
5904 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5905 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1)) &
5907 do j=1,nterm_sccor(isccori,isccori1)
5908 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5909 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5910 cosphi=dcos(j*tauangle(intertyp,i))
5911 sinphi=dsin(j*tauangle(intertyp,i))
5912 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
5913 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5914 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5916 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
5917 'esccor',i,intertyp,esccor_ii
5918 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5919 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5921 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5922 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,&
5923 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
5924 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5925 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5930 end subroutine eback_sc_corr
5931 !-----------------------------------------------------------------------------
5932 subroutine multibody(ecorr)
5933 ! This subroutine calculates multi-body contributions to energy following
5934 ! the idea of Skolnick et al. If side chains I and J make a contact and
5935 ! at the same time side chains I+1 and J+1 make a contact, an extra
5936 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5937 ! implicit real*8 (a-h,o-z)
5938 ! include 'DIMENSIONS'
5939 ! include 'COMMON.IOUNITS'
5940 ! include 'COMMON.DERIV'
5941 ! include 'COMMON.INTERACT'
5942 ! include 'COMMON.CONTACTS'
5943 real(kind=8),dimension(3) :: gx,gx1
5945 real(kind=8) :: ecorr
5946 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
5947 ! Set lprn=.true. for debugging
5951 write (iout,'(a)') 'Contact function values:'
5953 write (iout,'(i2,20(1x,i2,f10.5))') &
5954 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5959 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
5960 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
5972 num_conti=num_cont(i)
5973 num_conti1=num_cont(i1)
5978 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5979 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5980 !d & ' ishift=',ishift
5981 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5982 ! The system gains extra energy.
5983 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5984 endif ! j1==j+-ishift
5992 end subroutine multibody
5993 !-----------------------------------------------------------------------------
5994 real(kind=8) function esccorr(i,j,k,l,jj,kk)
5995 ! implicit real*8 (a-h,o-z)
5996 ! include 'DIMENSIONS'
5997 ! include 'COMMON.IOUNITS'
5998 ! include 'COMMON.DERIV'
5999 ! include 'COMMON.INTERACT'
6000 ! include 'COMMON.CONTACTS'
6001 real(kind=8),dimension(3) :: gx,gx1
6003 integer :: i,j,k,l,jj,kk,m,ll
6004 real(kind=8) :: eij,ekl
6008 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6009 ! Calculate the multi-body contribution to energy.
6010 ! Calculate multi-body contributions to the gradient.
6011 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6012 !d & k,l,(gacont(m,kk,k),m=1,3)
6014 gx(m) =ekl*gacont(m,jj,i)
6015 gx1(m)=eij*gacont(m,kk,k)
6016 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6017 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6018 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6019 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6023 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6028 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6033 end function esccorr
6034 !-----------------------------------------------------------------------------
6035 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6036 ! This subroutine calculates multi-body contributions to hydrogen-bonding
6037 ! implicit real*8 (a-h,o-z)
6038 ! include 'DIMENSIONS'
6039 ! include 'COMMON.IOUNITS'
6042 ! integer :: maxconts !max_cont=maxconts =nres/4
6043 integer,parameter :: max_dim=26
6044 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6045 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6046 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
6047 !el common /przechowalnia/ zapas
6048 integer :: status(MPI_STATUS_SIZE)
6049 integer,dimension((nres/4)*2) :: req !maxconts*2
6050 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
6052 ! include 'COMMON.SETUP'
6053 ! include 'COMMON.FFIELD'
6054 ! include 'COMMON.DERIV'
6055 ! include 'COMMON.INTERACT'
6056 ! include 'COMMON.CONTACTS'
6057 ! include 'COMMON.CONTROL'
6058 ! include 'COMMON.LOCAL'
6059 real(kind=8),dimension(3) :: gx,gx1
6060 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
6061 logical :: lprn,ldone
6063 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
6064 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
6066 ! Set lprn=.true. for debugging
6070 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
6073 if (nfgtasks.le.1) goto 30
6075 write (iout,'(a)') 'Contact function values before RECEIVE:'
6077 write (iout,'(2i3,50(1x,i2,f5.2))') &
6078 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6083 do i=1,ntask_cont_from
6086 do i=1,ntask_cont_to
6089 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6091 ! Make the list of contacts to send to send to other procesors
6092 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6094 do i=iturn3_start,iturn3_end
6095 ! write (iout,*) "make contact list turn3",i," num_cont",
6097 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6099 do i=iturn4_start,iturn4_end
6100 ! write (iout,*) "make contact list turn4",i," num_cont",
6102 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6106 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
6108 do j=1,num_cont_hb(i)
6111 iproc=iint_sent_local(k,jjc,ii)
6112 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6113 if (iproc.gt.0) then
6114 ncont_sent(iproc)=ncont_sent(iproc)+1
6115 nn=ncont_sent(iproc)
6117 zapas(2,nn,iproc)=jjc
6118 zapas(3,nn,iproc)=facont_hb(j,i)
6119 zapas(4,nn,iproc)=ees0p(j,i)
6120 zapas(5,nn,iproc)=ees0m(j,i)
6121 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6122 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6123 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6124 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6125 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6126 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6127 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6128 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6129 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6130 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6131 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6132 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6133 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6134 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6135 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6136 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6137 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6138 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6139 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6140 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6141 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6148 "Numbers of contacts to be sent to other processors",&
6149 (ncont_sent(i),i=1,ntask_cont_to)
6150 write (iout,*) "Contacts sent"
6151 do ii=1,ntask_cont_to
6153 iproc=itask_cont_to(ii)
6154 write (iout,*) nn," contacts to processor",iproc,&
6155 " of CONT_TO_COMM group"
6157 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6165 CorrelID1=nfgtasks+fg_rank+1
6167 ! Receive the numbers of needed contacts from other processors
6168 do ii=1,ntask_cont_from
6169 iproc=itask_cont_from(ii)
6171 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
6172 FG_COMM,req(ireq),IERR)
6174 ! write (iout,*) "IRECV ended"
6176 ! Send the number of contacts needed by other processors
6177 do ii=1,ntask_cont_to
6178 iproc=itask_cont_to(ii)
6180 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
6181 FG_COMM,req(ireq),IERR)
6183 ! write (iout,*) "ISEND ended"
6184 ! write (iout,*) "number of requests (nn)",ireq
6187 call MPI_Waitall(ireq,req,status_array,ierr)
6189 ! & "Numbers of contacts to be received from other processors",
6190 ! & (ncont_recv(i),i=1,ntask_cont_from)
6194 do ii=1,ntask_cont_from
6195 iproc=itask_cont_from(ii)
6197 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
6198 ! & " of CONT_TO_COMM group"
6202 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
6203 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6204 ! write (iout,*) "ireq,req",ireq,req(ireq)
6207 ! Send the contacts to processors that need them
6208 do ii=1,ntask_cont_to
6209 iproc=itask_cont_to(ii)
6211 ! write (iout,*) nn," contacts to processor",iproc,
6212 ! & " of CONT_TO_COMM group"
6215 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
6216 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6217 ! write (iout,*) "ireq,req",ireq,req(ireq)
6219 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6223 ! write (iout,*) "number of requests (contacts)",ireq
6224 ! write (iout,*) "req",(req(i),i=1,4)
6227 call MPI_Waitall(ireq,req,status_array,ierr)
6228 do iii=1,ntask_cont_from
6229 iproc=itask_cont_from(iii)
6232 write (iout,*) "Received",nn," contacts from processor",iproc,&
6233 " of CONT_FROM_COMM group"
6236 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6241 ii=zapas_recv(1,i,iii)
6242 ! Flag the received contacts to prevent double-counting
6243 jj=-zapas_recv(2,i,iii)
6244 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6246 nnn=num_cont_hb(ii)+1
6249 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6250 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6251 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6252 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6253 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6254 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6255 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6256 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6257 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6258 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6259 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6260 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6261 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6262 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6263 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6264 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6265 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6266 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6267 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6268 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6269 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6270 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6271 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6272 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6277 write (iout,'(a)') 'Contact function values after receive:'
6279 write (iout,'(2i3,50(1x,i3,f5.2))') &
6280 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6288 write (iout,'(a)') 'Contact function values:'
6290 write (iout,'(2i3,50(1x,i3,f5.2))') &
6291 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6297 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6298 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6299 ! Remove the loop below after debugging !!!
6306 ! Calculate the local-electrostatic correlation terms
6307 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6309 num_conti=num_cont_hb(i)
6310 num_conti1=num_cont_hb(i+1)
6317 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
6318 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
6319 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
6320 .or. j.lt.0 .and. j1.gt.0) .and. &
6321 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6322 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6323 ! The system gains extra energy.
6324 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6325 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
6326 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6328 else if (j1.eq.j) then
6329 ! Contacts I-J and I-(J+1) occur simultaneously.
6330 ! The system loses extra energy.
6331 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6336 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6337 ! & ' jj=',jj,' kk=',kk
6339 ! Contacts I-J and (I+1)-J occur simultaneously.
6340 ! The system loses extra energy.
6341 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6347 end subroutine multibody_hb
6348 !-----------------------------------------------------------------------------
6349 subroutine add_hb_contact(ii,jj,itask)
6350 ! implicit real*8 (a-h,o-z)
6351 ! include "DIMENSIONS"
6352 ! include "COMMON.IOUNITS"
6353 ! include "COMMON.CONTACTS"
6354 ! integer,parameter :: maxconts=nres/4
6355 integer,parameter :: max_dim=26
6356 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6357 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
6358 ! common /przechowalnia/ zapas
6359 integer :: i,j,ii,jj,iproc,nn,jjc
6360 integer,dimension(4) :: itask
6361 ! write (iout,*) "itask",itask
6364 if (iproc.gt.0) then
6365 do j=1,num_cont_hb(ii)
6367 ! write (iout,*) "i",ii," j",jj," jjc",jjc
6369 ncont_sent(iproc)=ncont_sent(iproc)+1
6370 nn=ncont_sent(iproc)
6371 zapas(1,nn,iproc)=ii
6372 zapas(2,nn,iproc)=jjc
6373 zapas(3,nn,iproc)=facont_hb(j,ii)
6374 zapas(4,nn,iproc)=ees0p(j,ii)
6375 zapas(5,nn,iproc)=ees0m(j,ii)
6376 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6377 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6378 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6379 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6380 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6381 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6382 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6383 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6384 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6385 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6386 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6387 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6388 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6389 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6390 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6391 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6392 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6393 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6394 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6395 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6396 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6403 end subroutine add_hb_contact
6404 !-----------------------------------------------------------------------------
6405 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
6406 ! This subroutine calculates multi-body contributions to hydrogen-bonding
6407 ! implicit real*8 (a-h,o-z)
6408 ! include 'DIMENSIONS'
6409 ! include 'COMMON.IOUNITS'
6410 integer,parameter :: max_dim=70
6413 ! integer :: maxconts !max_cont=maxconts=nres/4
6414 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6415 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
6416 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6417 ! common /przechowalnia/ zapas
6418 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
6419 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
6422 ! include 'COMMON.SETUP'
6423 ! include 'COMMON.FFIELD'
6424 ! include 'COMMON.DERIV'
6425 ! include 'COMMON.LOCAL'
6426 ! include 'COMMON.INTERACT'
6427 ! include 'COMMON.CONTACTS'
6428 ! include 'COMMON.CHAIN'
6429 ! include 'COMMON.CONTROL'
6430 real(kind=8),dimension(3) :: gx,gx1
6431 integer,dimension(nres) :: num_cont_hb_old
6432 logical :: lprn,ldone
6433 !EL double precision eello4,eello5,eelo6,eello_turn6
6434 !EL external eello4,eello5,eello6,eello_turn6
6436 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
6437 j1,jp1,i1,num_conti1
6438 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
6439 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
6441 ! Set lprn=.true. for debugging
6446 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
6448 num_cont_hb_old(i)=num_cont_hb(i)
6452 if (nfgtasks.le.1) goto 30
6454 write (iout,'(a)') 'Contact function values before RECEIVE:'
6456 write (iout,'(2i3,50(1x,i2,f5.2))') &
6457 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6462 do i=1,ntask_cont_from
6465 do i=1,ntask_cont_to
6468 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6470 ! Make the list of contacts to send to send to other procesors
6471 do i=iturn3_start,iturn3_end
6472 ! write (iout,*) "make contact list turn3",i," num_cont",
6474 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6476 do i=iturn4_start,iturn4_end
6477 ! write (iout,*) "make contact list turn4",i," num_cont",
6479 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6483 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
6485 do j=1,num_cont_hb(i)
6488 iproc=iint_sent_local(k,jjc,ii)
6489 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6490 if (iproc.ne.0) then
6491 ncont_sent(iproc)=ncont_sent(iproc)+1
6492 nn=ncont_sent(iproc)
6494 zapas(2,nn,iproc)=jjc
6495 zapas(3,nn,iproc)=d_cont(j,i)
6499 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6504 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6512 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6523 "Numbers of contacts to be sent to other processors",&
6524 (ncont_sent(i),i=1,ntask_cont_to)
6525 write (iout,*) "Contacts sent"
6526 do ii=1,ntask_cont_to
6528 iproc=itask_cont_to(ii)
6529 write (iout,*) nn," contacts to processor",iproc,&
6530 " of CONT_TO_COMM group"
6532 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6540 CorrelID1=nfgtasks+fg_rank+1
6542 ! Receive the numbers of needed contacts from other processors
6543 do ii=1,ntask_cont_from
6544 iproc=itask_cont_from(ii)
6546 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
6547 FG_COMM,req(ireq),IERR)
6549 ! write (iout,*) "IRECV ended"
6551 ! Send the number of contacts needed by other processors
6552 do ii=1,ntask_cont_to
6553 iproc=itask_cont_to(ii)
6555 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
6556 FG_COMM,req(ireq),IERR)
6558 ! write (iout,*) "ISEND ended"
6559 ! write (iout,*) "number of requests (nn)",ireq
6562 call MPI_Waitall(ireq,req,status_array,ierr)
6564 ! & "Numbers of contacts to be received from other processors",
6565 ! & (ncont_recv(i),i=1,ntask_cont_from)
6569 do ii=1,ntask_cont_from
6570 iproc=itask_cont_from(ii)
6572 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
6573 ! & " of CONT_TO_COMM group"
6577 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
6578 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6579 ! write (iout,*) "ireq,req",ireq,req(ireq)
6582 ! Send the contacts to processors that need them
6583 do ii=1,ntask_cont_to
6584 iproc=itask_cont_to(ii)
6586 ! write (iout,*) nn," contacts to processor",iproc,
6587 ! & " of CONT_TO_COMM group"
6590 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
6591 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6592 ! write (iout,*) "ireq,req",ireq,req(ireq)
6594 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6598 ! write (iout,*) "number of requests (contacts)",ireq
6599 ! write (iout,*) "req",(req(i),i=1,4)
6602 call MPI_Waitall(ireq,req,status_array,ierr)
6603 do iii=1,ntask_cont_from
6604 iproc=itask_cont_from(iii)
6607 write (iout,*) "Received",nn," contacts from processor",iproc,&
6608 " of CONT_FROM_COMM group"
6611 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6616 ii=zapas_recv(1,i,iii)
6617 ! Flag the received contacts to prevent double-counting
6618 jj=-zapas_recv(2,i,iii)
6619 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6621 nnn=num_cont_hb(ii)+1
6624 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6628 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6633 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6641 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6650 write (iout,'(a)') 'Contact function values after receive:'
6652 write (iout,'(2i3,50(1x,i3,5f6.3))') &
6653 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
6654 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6661 write (iout,'(a)') 'Contact function values:'
6663 write (iout,'(2i3,50(1x,i2,5f6.3))') &
6664 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
6665 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6672 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6673 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6674 ! Remove the loop below after debugging !!!
6681 ! Calculate the dipole-dipole interaction energies
6682 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6683 do i=iatel_s,iatel_e+1
6684 num_conti=num_cont_hb(i)
6693 ! Calculate the local-electrostatic correlation terms
6694 ! write (iout,*) "gradcorr5 in eello5 before loop"
6696 ! write (iout,'(i5,3f10.5)')
6697 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6699 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6700 ! write (iout,*) "corr loop i",i
6702 num_conti=num_cont_hb(i)
6703 num_conti1=num_cont_hb(i+1)
6710 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6711 ! & ' jj=',jj,' kk=',kk
6712 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
6713 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
6714 .or. j.lt.0 .and. j1.gt.0) .and. &
6715 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6716 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6717 ! The system gains extra energy.
6719 sqd1=dsqrt(d_cont(jj,i))
6720 sqd2=dsqrt(d_cont(kk,i1))
6721 sred_geom = sqd1*sqd2
6722 IF (sred_geom.lt.cutoff_corr) THEN
6723 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
6725 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6726 !d & ' jj=',jj,' kk=',kk
6727 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6728 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6730 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6731 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6734 !d write (iout,*) 'sred_geom=',sred_geom,
6735 !d & ' ekont=',ekont,' fprim=',fprimcont,
6736 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6737 !d write (iout,*) "g_contij",g_contij
6738 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6739 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6740 call calc_eello(i,jp,i+1,jp1,jj,kk)
6741 if (wcorr4.gt.0.0d0) &
6742 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6743 if (energy_dec.and.wcorr4.gt.0.0d0) &
6744 write (iout,'(a6,4i5,0pf7.3)') &
6745 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6746 ! write (iout,*) "gradcorr5 before eello5"
6748 ! write (iout,'(i5,3f10.5)')
6749 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6751 if (wcorr5.gt.0.0d0) &
6752 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6753 ! write (iout,*) "gradcorr5 after eello5"
6755 ! write (iout,'(i5,3f10.5)')
6756 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6758 if (energy_dec.and.wcorr5.gt.0.0d0) &
6759 write (iout,'(a6,4i5,0pf7.3)') &
6760 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6761 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6762 !d write(2,*)'ijkl',i,jp,i+1,jp1
6763 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
6764 .or. wturn6.eq.0.0d0))then
6765 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6766 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6767 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
6768 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6769 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6770 !d & 'ecorr6=',ecorr6
6771 !d write (iout,'(4e15.5)') sred_geom,
6772 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6773 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6774 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6775 else if (wturn6.gt.0.0d0 &
6776 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6777 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6778 eturn6=eturn6+eello_turn6(i,jj,kk)
6779 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
6780 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6781 !d write (2,*) 'multibody_eello:eturn6',eturn6
6790 num_cont_hb(i)=num_cont_hb_old(i)
6792 ! write (iout,*) "gradcorr5 in eello5"
6794 ! write (iout,'(i5,3f10.5)')
6795 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6798 end subroutine multibody_eello
6799 !-----------------------------------------------------------------------------
6800 subroutine add_hb_contact_eello(ii,jj,itask)
6801 ! implicit real*8 (a-h,o-z)
6802 ! include "DIMENSIONS"
6803 ! include "COMMON.IOUNITS"
6804 ! include "COMMON.CONTACTS"
6805 ! integer,parameter :: maxconts=nres/4
6806 integer,parameter :: max_dim=70
6807 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
6808 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6809 ! common /przechowalnia/ zapas
6811 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
6812 integer,dimension(4) ::itask
6813 ! write (iout,*) "itask",itask
6816 if (iproc.gt.0) then
6817 do j=1,num_cont_hb(ii)
6819 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6821 ncont_sent(iproc)=ncont_sent(iproc)+1
6822 nn=ncont_sent(iproc)
6823 zapas(1,nn,iproc)=ii
6824 zapas(2,nn,iproc)=jjc
6825 zapas(3,nn,iproc)=d_cont(j,ii)
6829 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6834 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6842 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6853 end subroutine add_hb_contact_eello
6854 !-----------------------------------------------------------------------------
6855 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6856 ! implicit real*8 (a-h,o-z)
6857 ! include 'DIMENSIONS'
6858 ! include 'COMMON.IOUNITS'
6859 ! include 'COMMON.DERIV'
6860 ! include 'COMMON.INTERACT'
6861 ! include 'COMMON.CONTACTS'
6862 real(kind=8),dimension(3) :: gx,gx1
6865 integer :: i,j,k,l,jj,kk,ll
6866 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
6867 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
6868 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl
6878 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6879 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6880 ! Following 4 lines for diagnostics.
6885 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6886 ! & 'Contacts ',i,j,
6887 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6888 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6890 ! Calculate the multi-body contribution to energy.
6891 ! ecorr=ecorr+ekont*ees
6892 ! Calculate multi-body contributions to the gradient.
6893 coeffpees0pij=coeffp*ees0pij
6894 coeffmees0mij=coeffm*ees0mij
6895 coeffpees0pkl=coeffp*ees0pkl
6896 coeffmees0mkl=coeffm*ees0mkl
6898 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6899 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
6900 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
6901 coeffmees0mkl*gacontm_hb1(ll,jj,i))
6902 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
6903 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
6904 coeffmees0mkl*gacontm_hb2(ll,jj,i))
6905 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6906 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
6907 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
6908 coeffmees0mij*gacontm_hb1(ll,kk,k))
6909 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
6910 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
6911 coeffmees0mij*gacontm_hb2(ll,kk,k))
6912 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
6913 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
6914 coeffmees0mkl*gacontm_hb3(ll,jj,i))
6915 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6916 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6917 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
6918 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
6919 coeffmees0mij*gacontm_hb3(ll,kk,k))
6920 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6921 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6922 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6927 !grad gradcorr(ll,m)=gradcorr(ll,m)+
6928 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
6929 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6930 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6935 !grad gradcorr(ll,m)=gradcorr(ll,m)+
6936 !grad & ees*eij*gacont_hbr(ll,kk,k)-
6937 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6938 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6941 ! write (iout,*) "ehbcorr",ekont*ees
6944 end function ehbcorr
6946 !-----------------------------------------------------------------------------
6947 subroutine dipole(i,j,jj)
6948 ! implicit real*8 (a-h,o-z)
6949 ! include 'DIMENSIONS'
6950 ! include 'COMMON.IOUNITS'
6951 ! include 'COMMON.CHAIN'
6952 ! include 'COMMON.FFIELD'
6953 ! include 'COMMON.DERIV'
6954 ! include 'COMMON.INTERACT'
6955 ! include 'COMMON.CONTACTS'
6956 ! include 'COMMON.TORSION'
6957 ! include 'COMMON.VAR'
6958 ! include 'COMMON.GEO'
6959 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
6960 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
6961 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
6963 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
6964 allocate(dipderx(3,5,4,maxconts,nres))
6967 iti1 = itortyp(itype(i+1))
6968 if (j.lt.nres-1) then
6969 itj1 = itortyp(itype(j+1))
6974 dipi(iii,1)=Ub2(iii,i)
6975 dipderi(iii)=Ub2der(iii,i)
6976 dipi(iii,2)=b1(iii,iti1)
6977 dipj(iii,1)=Ub2(iii,j)
6978 dipderj(iii)=Ub2der(iii,j)
6979 dipj(iii,2)=b1(iii,itj1)
6983 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6986 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6993 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
6997 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7002 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7003 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7005 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7007 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7009 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7012 end subroutine dipole
7014 !-----------------------------------------------------------------------------
7015 subroutine calc_eello(i,j,k,l,jj,kk)
7017 ! This subroutine computes matrices and vectors needed to calculate
7018 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
7021 ! implicit real*8 (a-h,o-z)
7022 ! include 'DIMENSIONS'
7023 ! include 'COMMON.IOUNITS'
7024 ! include 'COMMON.CHAIN'
7025 ! include 'COMMON.DERIV'
7026 ! include 'COMMON.INTERACT'
7027 ! include 'COMMON.CONTACTS'
7028 ! include 'COMMON.TORSION'
7029 ! include 'COMMON.VAR'
7030 ! include 'COMMON.GEO'
7031 ! include 'COMMON.FFIELD'
7032 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
7033 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
7034 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
7037 !el common /kutas/ lprn
7038 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7039 !d & ' jj=',jj,' kk=',kk
7040 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7041 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7042 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7045 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7046 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7049 call transpose2(aa1(1,1),aa1t(1,1))
7050 call transpose2(aa2(1,1),aa2t(1,1))
7053 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
7054 aa1tder(1,1,lll,kkk))
7055 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
7056 aa2tder(1,1,lll,kkk))
7060 ! parallel orientation of the two CA-CA-CA frames.
7062 iti=itortyp(itype(i))
7066 itk1=itortyp(itype(k+1))
7067 itj=itortyp(itype(j))
7068 if (l.lt.nres-1) then
7069 itl1=itortyp(itype(l+1))
7073 ! A1 kernel(j+1) A2T
7075 !d write (iout,'(3f10.5,5x,3f10.5)')
7076 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7078 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7079 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
7080 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7081 ! Following matrices are needed only for 6-th order cumulants
7082 IF (wcorr6.gt.0.0d0) THEN
7083 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7084 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
7085 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7086 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7087 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
7088 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
7089 ADtEAderx(1,1,1,1,1,1))
7091 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7092 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
7093 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
7094 ADtEA1derx(1,1,1,1,1,1))
7096 ! End 6-th order cumulants
7099 !d write (2,*) 'In calc_eello6'
7101 !d write (2,*) 'iii=',iii
7103 !d write (2,*) 'kkk=',kkk
7105 !d write (2,'(3(2f10.5),5x)')
7106 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7111 call transpose2(EUgder(1,1,k),auxmat(1,1))
7112 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7113 call transpose2(EUg(1,1,k),auxmat(1,1))
7114 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7115 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7119 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7120 EAEAderx(1,1,lll,kkk,iii,1))
7124 ! A1T kernel(i+1) A2
7125 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7126 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
7127 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7128 ! Following matrices are needed only for 6-th order cumulants
7129 IF (wcorr6.gt.0.0d0) THEN
7130 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7131 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
7132 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7133 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7134 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
7135 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
7136 ADtEAderx(1,1,1,1,1,2))
7137 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7138 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
7139 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
7140 ADtEA1derx(1,1,1,1,1,2))
7142 ! End 6-th order cumulants
7143 call transpose2(EUgder(1,1,l),auxmat(1,1))
7144 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7145 call transpose2(EUg(1,1,l),auxmat(1,1))
7146 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7147 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7151 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7152 EAEAderx(1,1,lll,kkk,iii,2))
7157 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7158 ! They are needed only when the fifth- or the sixth-order cumulants are
7160 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7161 call transpose2(AEA(1,1,1),auxmat(1,1))
7162 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7163 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7164 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7165 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7166 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7167 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7168 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7169 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7170 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7171 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7172 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7173 call transpose2(AEA(1,1,2),auxmat(1,1))
7174 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7175 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7176 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7177 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7178 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7179 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7180 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7181 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7182 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7183 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7184 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7185 ! Calculate the Cartesian derivatives of the vectors.
7189 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7190 call matvec2(auxmat(1,1),b1(1,iti),&
7191 AEAb1derx(1,lll,kkk,iii,1,1))
7192 call matvec2(auxmat(1,1),Ub2(1,i),&
7193 AEAb2derx(1,lll,kkk,iii,1,1))
7194 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
7195 AEAb1derx(1,lll,kkk,iii,2,1))
7196 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
7197 AEAb2derx(1,lll,kkk,iii,2,1))
7198 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7199 call matvec2(auxmat(1,1),b1(1,itj),&
7200 AEAb1derx(1,lll,kkk,iii,1,2))
7201 call matvec2(auxmat(1,1),Ub2(1,j),&
7202 AEAb2derx(1,lll,kkk,iii,1,2))
7203 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
7204 AEAb1derx(1,lll,kkk,iii,2,2))
7205 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
7206 AEAb2derx(1,lll,kkk,iii,2,2))
7213 ! Antiparallel orientation of the two CA-CA-CA frames.
7215 iti=itortyp(itype(i))
7219 itk1=itortyp(itype(k+1))
7220 itl=itortyp(itype(l))
7221 itj=itortyp(itype(j))
7222 if (j.lt.nres-1) then
7223 itj1=itortyp(itype(j+1))
7227 ! A2 kernel(j-1)T A1T
7228 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7229 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
7230 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7231 ! Following matrices are needed only for 6-th order cumulants
7232 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
7233 j.eq.i+4 .and. l.eq.i+3)) THEN
7234 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7235 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
7236 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7237 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7238 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
7239 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
7240 ADtEAderx(1,1,1,1,1,1))
7241 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7242 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
7243 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
7244 ADtEA1derx(1,1,1,1,1,1))
7246 ! End 6-th order cumulants
7247 call transpose2(EUgder(1,1,k),auxmat(1,1))
7248 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7249 call transpose2(EUg(1,1,k),auxmat(1,1))
7250 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7251 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7255 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7256 EAEAderx(1,1,lll,kkk,iii,1))
7260 ! A2T kernel(i+1)T A1
7261 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7262 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
7263 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7264 ! Following matrices are needed only for 6-th order cumulants
7265 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
7266 j.eq.i+4 .and. l.eq.i+3)) THEN
7267 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7268 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
7269 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7270 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7271 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
7272 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
7273 ADtEAderx(1,1,1,1,1,2))
7274 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7275 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
7276 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
7277 ADtEA1derx(1,1,1,1,1,2))
7279 ! End 6-th order cumulants
7280 call transpose2(EUgder(1,1,j),auxmat(1,1))
7281 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7282 call transpose2(EUg(1,1,j),auxmat(1,1))
7283 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7284 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7288 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7289 EAEAderx(1,1,lll,kkk,iii,2))
7294 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7295 ! They are needed only when the fifth- or the sixth-order cumulants are
7297 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
7298 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7299 call transpose2(AEA(1,1,1),auxmat(1,1))
7300 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7301 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7302 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7303 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7304 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7305 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7306 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7307 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7308 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7309 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7310 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7311 call transpose2(AEA(1,1,2),auxmat(1,1))
7312 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7313 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7314 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7315 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7316 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7317 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7318 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7319 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7320 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7321 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7322 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7323 ! Calculate the Cartesian derivatives of the vectors.
7327 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7328 call matvec2(auxmat(1,1),b1(1,iti),&
7329 AEAb1derx(1,lll,kkk,iii,1,1))
7330 call matvec2(auxmat(1,1),Ub2(1,i),&
7331 AEAb2derx(1,lll,kkk,iii,1,1))
7332 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
7333 AEAb1derx(1,lll,kkk,iii,2,1))
7334 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
7335 AEAb2derx(1,lll,kkk,iii,2,1))
7336 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7337 call matvec2(auxmat(1,1),b1(1,itl),&
7338 AEAb1derx(1,lll,kkk,iii,1,2))
7339 call matvec2(auxmat(1,1),Ub2(1,l),&
7340 AEAb2derx(1,lll,kkk,iii,1,2))
7341 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
7342 AEAb1derx(1,lll,kkk,iii,2,2))
7343 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
7344 AEAb2derx(1,lll,kkk,iii,2,2))
7352 end subroutine calc_eello
7353 !-----------------------------------------------------------------------------
7354 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
7359 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
7360 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
7361 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
7362 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
7363 integer :: iii,kkk,lll
7366 !el common /kutas/ lprn
7367 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7369 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
7372 !d if (lprn) write (2,*) 'In kernel'
7374 !d if (lprn) write (2,*) 'kkk=',kkk
7376 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
7377 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7379 !d write (2,*) 'lll=',lll
7380 !d write (2,*) 'iii=1'
7382 !d write (2,'(3(2f10.5),5x)')
7383 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7386 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
7387 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7389 !d write (2,*) 'lll=',lll
7390 !d write (2,*) 'iii=2'
7392 !d write (2,'(3(2f10.5),5x)')
7393 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7399 end subroutine kernel
7400 !-----------------------------------------------------------------------------
7401 real(kind=8) function eello4(i,j,k,l,jj,kk)
7402 ! implicit real*8 (a-h,o-z)
7403 ! include 'DIMENSIONS'
7404 ! include 'COMMON.IOUNITS'
7405 ! include 'COMMON.CHAIN'
7406 ! include 'COMMON.DERIV'
7407 ! include 'COMMON.INTERACT'
7408 ! include 'COMMON.CONTACTS'
7409 ! include 'COMMON.TORSION'
7410 ! include 'COMMON.VAR'
7411 ! include 'COMMON.GEO'
7412 real(kind=8),dimension(2,2) :: pizda
7413 real(kind=8),dimension(3) :: ggg1,ggg2
7414 real(kind=8) :: eel4,glongij,glongkl
7415 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
7416 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7420 !d print *,'eello4:',i,j,k,l,jj,kk
7421 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
7422 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
7423 !old eij=facont_hb(jj,i)
7424 !old ekl=facont_hb(kk,k)
7426 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7427 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7428 gcorr_loc(k-1)=gcorr_loc(k-1) &
7429 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7431 gcorr_loc(l-1)=gcorr_loc(l-1) &
7432 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7434 gcorr_loc(j-1)=gcorr_loc(j-1) &
7435 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7440 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
7441 -EAEAderx(2,2,lll,kkk,iii,1)
7442 !d derx(lll,kkk,iii)=0.0d0
7446 !d gcorr_loc(l-1)=0.0d0
7447 !d gcorr_loc(j-1)=0.0d0
7448 !d gcorr_loc(k-1)=0.0d0
7450 !d write (iout,*)'Contacts have occurred for peptide groups',
7451 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
7452 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7453 if (j.lt.nres-1) then
7460 if (l.lt.nres-1) then
7468 !grad ggg1(ll)=eel4*g_contij(ll,1)
7469 !grad ggg2(ll)=eel4*g_contij(ll,2)
7470 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7471 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7472 !grad ghalf=0.5d0*ggg1(ll)
7473 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7474 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7475 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7476 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7477 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7478 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7479 !grad ghalf=0.5d0*ggg2(ll)
7480 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7481 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7482 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7483 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7484 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7485 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7489 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7494 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7499 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7504 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7508 !d write (2,*) iii,gcorr_loc(iii)
7511 !d write (2,*) 'ekont',ekont
7512 !d write (iout,*) 'eello4',ekont*eel4
7515 !-----------------------------------------------------------------------------
7516 real(kind=8) function eello5(i,j,k,l,jj,kk)
7517 ! implicit real*8 (a-h,o-z)
7518 ! include 'DIMENSIONS'
7519 ! include 'COMMON.IOUNITS'
7520 ! include 'COMMON.CHAIN'
7521 ! include 'COMMON.DERIV'
7522 ! include 'COMMON.INTERACT'
7523 ! include 'COMMON.CONTACTS'
7524 ! include 'COMMON.TORSION'
7525 ! include 'COMMON.VAR'
7526 ! include 'COMMON.GEO'
7527 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
7528 real(kind=8),dimension(2) :: vv
7529 real(kind=8),dimension(3) :: ggg1,ggg2
7530 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
7531 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
7532 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
7533 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7538 ! /l\ / \ \ / \ / \ / C
7539 ! / \ / \ \ / \ / \ / C
7540 ! j| o |l1 | o | o| o | | o |o C
7541 ! \ |/k\| |/ \| / |/ \| |/ \| C
7542 ! \i/ \ / \ / / \ / \ C
7544 ! (I) (II) (III) (IV) C
7546 ! eello5_1 eello5_2 eello5_3 eello5_4 C
7548 ! Antiparallel chains C
7551 ! /j\ / \ \ / \ / \ / C
7552 ! / \ / \ \ / \ / \ / C
7553 ! j1| o |l | o | o| o | | o |o C
7554 ! \ |/k\| |/ \| / |/ \| |/ \| C
7555 ! \i/ \ / \ / / \ / \ C
7557 ! (I) (II) (III) (IV) C
7559 ! eello5_1 eello5_2 eello5_3 eello5_4 C
7561 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
7563 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7564 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7569 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7571 itk=itortyp(itype(k))
7572 itl=itortyp(itype(l))
7573 itj=itortyp(itype(j))
7578 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7579 !d & eel5_3_num,eel5_4_num)
7583 derx(lll,kkk,iii)=0.0d0
7587 !d eij=facont_hb(jj,i)
7588 !d ekl=facont_hb(kk,k)
7590 !d write (iout,*)'Contacts have occurred for peptide groups',
7591 !d & i,j,' fcont:',eij,' eij',' and ',k,l
7593 ! Contribution from the graph I.
7594 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7595 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7596 call transpose2(EUg(1,1,k),auxmat(1,1))
7597 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7598 vv(1)=pizda(1,1)-pizda(2,2)
7599 vv(2)=pizda(1,2)+pizda(2,1)
7600 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
7601 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7602 ! Explicit gradient in virtual-dihedral angles.
7603 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
7604 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
7605 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7606 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7607 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7608 vv(1)=pizda(1,1)-pizda(2,2)
7609 vv(2)=pizda(1,2)+pizda(2,1)
7610 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7611 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
7612 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7613 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7614 vv(1)=pizda(1,1)-pizda(2,2)
7615 vv(2)=pizda(1,2)+pizda(2,1)
7617 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7618 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
7619 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7621 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7622 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
7623 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7625 ! Cartesian gradient
7629 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
7631 vv(1)=pizda(1,1)-pizda(2,2)
7632 vv(2)=pizda(1,2)+pizda(2,1)
7633 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7634 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
7635 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7641 ! Contribution from graph II
7642 call transpose2(EE(1,1,itk),auxmat(1,1))
7643 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7644 vv(1)=pizda(1,1)+pizda(2,2)
7645 vv(2)=pizda(2,1)-pizda(1,2)
7646 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
7647 -0.5d0*scalar2(vv(1),Ctobr(1,k))
7648 ! Explicit gradient in virtual-dihedral angles.
7649 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7650 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7651 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7652 vv(1)=pizda(1,1)+pizda(2,2)
7653 vv(2)=pizda(2,1)-pizda(1,2)
7655 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7656 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
7657 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7659 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7660 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
7661 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7663 ! Cartesian gradient
7667 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7669 vv(1)=pizda(1,1)+pizda(2,2)
7670 vv(2)=pizda(2,1)-pizda(1,2)
7671 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7672 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
7673 -0.5d0*scalar2(vv(1),Ctobr(1,k))
7681 ! Parallel orientation
7682 ! Contribution from graph III
7683 call transpose2(EUg(1,1,l),auxmat(1,1))
7684 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7685 vv(1)=pizda(1,1)-pizda(2,2)
7686 vv(2)=pizda(1,2)+pizda(2,1)
7687 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
7688 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7689 ! Explicit gradient in virtual-dihedral angles.
7690 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7691 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
7692 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7693 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7694 vv(1)=pizda(1,1)-pizda(2,2)
7695 vv(2)=pizda(1,2)+pizda(2,1)
7696 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7697 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
7698 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7699 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7700 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7701 vv(1)=pizda(1,1)-pizda(2,2)
7702 vv(2)=pizda(1,2)+pizda(2,1)
7703 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7704 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
7705 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7706 ! Cartesian gradient
7710 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
7712 vv(1)=pizda(1,1)-pizda(2,2)
7713 vv(2)=pizda(1,2)+pizda(2,1)
7714 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7715 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
7716 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7721 ! Contribution from graph IV
7723 call transpose2(EE(1,1,itl),auxmat(1,1))
7724 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7725 vv(1)=pizda(1,1)+pizda(2,2)
7726 vv(2)=pizda(2,1)-pizda(1,2)
7727 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
7728 -0.5d0*scalar2(vv(1),Ctobr(1,l))
7729 ! Explicit gradient in virtual-dihedral angles.
7730 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7731 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7732 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7733 vv(1)=pizda(1,1)+pizda(2,2)
7734 vv(2)=pizda(2,1)-pizda(1,2)
7735 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7736 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
7737 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7738 ! Cartesian gradient
7742 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7744 vv(1)=pizda(1,1)+pizda(2,2)
7745 vv(2)=pizda(2,1)-pizda(1,2)
7746 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7747 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
7748 -0.5d0*scalar2(vv(1),Ctobr(1,l))
7753 ! Antiparallel orientation
7754 ! Contribution from graph III
7756 call transpose2(EUg(1,1,j),auxmat(1,1))
7757 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7758 vv(1)=pizda(1,1)-pizda(2,2)
7759 vv(2)=pizda(1,2)+pizda(2,1)
7760 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
7761 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7762 ! Explicit gradient in virtual-dihedral angles.
7763 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7764 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
7765 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7766 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7767 vv(1)=pizda(1,1)-pizda(2,2)
7768 vv(2)=pizda(1,2)+pizda(2,1)
7769 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7770 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
7771 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7772 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7773 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7774 vv(1)=pizda(1,1)-pizda(2,2)
7775 vv(2)=pizda(1,2)+pizda(2,1)
7776 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7777 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
7778 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7779 ! Cartesian gradient
7783 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
7785 vv(1)=pizda(1,1)-pizda(2,2)
7786 vv(2)=pizda(1,2)+pizda(2,1)
7787 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
7788 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
7789 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7794 ! Contribution from graph IV
7796 call transpose2(EE(1,1,itj),auxmat(1,1))
7797 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7798 vv(1)=pizda(1,1)+pizda(2,2)
7799 vv(2)=pizda(2,1)-pizda(1,2)
7800 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
7801 -0.5d0*scalar2(vv(1),Ctobr(1,j))
7802 ! Explicit gradient in virtual-dihedral angles.
7803 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7804 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7805 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7806 vv(1)=pizda(1,1)+pizda(2,2)
7807 vv(2)=pizda(2,1)-pizda(1,2)
7808 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7809 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
7810 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7811 ! Cartesian gradient
7815 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7817 vv(1)=pizda(1,1)+pizda(2,2)
7818 vv(2)=pizda(2,1)-pizda(1,2)
7819 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
7820 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
7821 -0.5d0*scalar2(vv(1),Ctobr(1,j))
7827 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7828 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7829 !d write (2,*) 'ijkl',i,j,k,l
7830 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7831 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
7833 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7834 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7835 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7836 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7837 if (j.lt.nres-1) then
7844 if (l.lt.nres-1) then
7854 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7855 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
7856 ! summed up outside the subrouine as for the other subroutines
7857 ! handling long-range interactions. The old code is commented out
7858 ! with "cgrad" to keep track of changes.
7860 !grad ggg1(ll)=eel5*g_contij(ll,1)
7861 !grad ggg2(ll)=eel5*g_contij(ll,2)
7862 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7863 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7864 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7865 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7866 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7867 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7868 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7869 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7871 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7872 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7873 !grad ghalf=0.5d0*ggg1(ll)
7875 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7876 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7877 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7878 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7879 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7880 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7881 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7882 !grad ghalf=0.5d0*ggg2(ll)
7884 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7885 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7886 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7887 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7888 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7889 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7894 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7895 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7900 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7901 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7907 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7912 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7916 !d write (2,*) iii,g_corr5_loc(iii)
7919 !d write (2,*) 'ekont',ekont
7920 !d write (iout,*) 'eello5',ekont*eel5
7923 !-----------------------------------------------------------------------------
7924 real(kind=8) function eello6(i,j,k,l,jj,kk)
7925 ! implicit real*8 (a-h,o-z)
7926 ! include 'DIMENSIONS'
7927 ! include 'COMMON.IOUNITS'
7928 ! include 'COMMON.CHAIN'
7929 ! include 'COMMON.DERIV'
7930 ! include 'COMMON.INTERACT'
7931 ! include 'COMMON.CONTACTS'
7932 ! include 'COMMON.TORSION'
7933 ! include 'COMMON.VAR'
7934 ! include 'COMMON.GEO'
7935 ! include 'COMMON.FFIELD'
7936 real(kind=8),dimension(3) :: ggg1,ggg2
7937 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
7939 real(kind=8) :: gradcorr6ij,gradcorr6kl
7940 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
7941 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7946 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7954 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7955 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7959 derx(lll,kkk,iii)=0.0d0
7963 !d eij=facont_hb(jj,i)
7964 !d ekl=facont_hb(kk,k)
7970 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7971 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7972 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7973 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7974 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7975 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7977 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7978 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7979 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7980 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7981 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7982 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7986 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7988 ! If turn contributions are considered, they will be handled separately.
7989 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7990 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7991 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7992 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7993 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7994 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7995 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7997 if (j.lt.nres-1) then
8004 if (l.lt.nres-1) then
8012 !grad ggg1(ll)=eel6*g_contij(ll,1)
8013 !grad ggg2(ll)=eel6*g_contij(ll,2)
8014 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8015 !grad ghalf=0.5d0*ggg1(ll)
8017 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8018 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8019 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8020 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8021 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8022 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8023 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8024 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8025 !grad ghalf=0.5d0*ggg2(ll)
8026 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8028 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8029 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8030 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8031 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8032 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8033 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8038 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8039 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8044 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8045 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8051 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8056 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8060 !d write (2,*) iii,g_corr6_loc(iii)
8063 !d write (2,*) 'ekont',ekont
8064 !d write (iout,*) 'eello6',ekont*eel6
8067 !-----------------------------------------------------------------------------
8068 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
8070 ! implicit real*8 (a-h,o-z)
8071 ! include 'DIMENSIONS'
8072 ! include 'COMMON.IOUNITS'
8073 ! include 'COMMON.CHAIN'
8074 ! include 'COMMON.DERIV'
8075 ! include 'COMMON.INTERACT'
8076 ! include 'COMMON.CONTACTS'
8077 ! include 'COMMON.TORSION'
8078 ! include 'COMMON.VAR'
8079 ! include 'COMMON.GEO'
8080 real(kind=8),dimension(2) :: vv,vv1
8081 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
8084 !el common /kutas/ lprn
8085 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
8086 real(kind=8) :: s1,s2,s3,s4,s5
8087 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8089 ! Parallel Antiparallel C
8095 ! \ j|/k\| / \ |/k\|l / C
8100 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8101 itk=itortyp(itype(k))
8102 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8103 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8104 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8105 call transpose2(EUgC(1,1,k),auxmat(1,1))
8106 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8107 vv1(1)=pizda1(1,1)-pizda1(2,2)
8108 vv1(2)=pizda1(1,2)+pizda1(2,1)
8109 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8110 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8111 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8112 s5=scalar2(vv(1),Dtobr2(1,i))
8113 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8114 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8115 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
8116 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
8117 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
8118 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
8119 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
8120 +scalar2(vv(1),Dtobr2der(1,i)))
8121 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8122 vv1(1)=pizda1(1,1)-pizda1(2,2)
8123 vv1(2)=pizda1(1,2)+pizda1(2,1)
8124 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8125 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8127 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
8128 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
8129 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
8130 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
8131 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8133 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
8134 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
8135 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
8136 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
8137 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8139 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8140 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8141 vv1(1)=pizda1(1,1)-pizda1(2,2)
8142 vv1(2)=pizda1(1,2)+pizda1(2,1)
8143 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
8144 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
8145 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
8146 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8155 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8156 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8157 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8158 call transpose2(EUgC(1,1,k),auxmat(1,1))
8159 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
8161 vv1(1)=pizda1(1,1)-pizda1(2,2)
8162 vv1(2)=pizda1(1,2)+pizda1(2,1)
8163 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8164 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
8165 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8166 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
8167 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8168 s5=scalar2(vv(1),Dtobr2(1,i))
8169 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8174 end function eello6_graph1
8175 !-----------------------------------------------------------------------------
8176 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
8178 ! implicit real*8 (a-h,o-z)
8179 ! include 'DIMENSIONS'
8180 ! include 'COMMON.IOUNITS'
8181 ! include 'COMMON.CHAIN'
8182 ! include 'COMMON.DERIV'
8183 ! include 'COMMON.INTERACT'
8184 ! include 'COMMON.CONTACTS'
8185 ! include 'COMMON.TORSION'
8186 ! include 'COMMON.VAR'
8187 ! include 'COMMON.GEO'
8189 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
8190 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8192 !el common /kutas/ lprn
8193 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
8194 real(kind=8) :: s2,s3,s4
8195 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8197 ! Parallel Antiparallel C
8203 ! \ j|/k\| \ |/k\|l C
8208 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8209 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8210 ! AL 7/4/01 s1 would occur in the sixth-order moment,
8211 ! but not in a cluster cumulant
8213 s1=dip(1,jj,i)*dip(1,kk,k)
8215 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8216 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8217 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8218 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8219 call transpose2(EUg(1,1,k),auxmat(1,1))
8220 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8221 vv(1)=pizda(1,1)-pizda(2,2)
8222 vv(2)=pizda(1,2)+pizda(2,1)
8223 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8224 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8226 eello6_graph2=-(s1+s2+s3+s4)
8228 eello6_graph2=-(s2+s3+s4)
8231 ! Derivatives in gamma(i-1)
8234 s1=dipderg(1,jj,i)*dip(1,kk,k)
8236 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8237 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8238 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8239 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8241 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8243 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8245 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8247 ! Derivatives in gamma(k-1)
8249 s1=dip(1,jj,i)*dipderg(1,kk,k)
8251 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8252 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8253 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8254 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8255 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8256 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8257 vv(1)=pizda(1,1)-pizda(2,2)
8258 vv(2)=pizda(1,2)+pizda(2,1)
8259 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8261 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8263 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8265 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8266 ! Derivatives in gamma(j-1) or gamma(l-1)
8269 s1=dipderg(3,jj,i)*dip(1,kk,k)
8271 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8272 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8273 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8274 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8275 vv(1)=pizda(1,1)-pizda(2,2)
8276 vv(2)=pizda(1,2)+pizda(2,1)
8277 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8280 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8282 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8285 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8286 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8288 ! Derivatives in gamma(l-1) or gamma(j-1)
8291 s1=dip(1,jj,i)*dipderg(3,kk,k)
8293 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8294 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8295 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8296 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8297 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8298 vv(1)=pizda(1,1)-pizda(2,2)
8299 vv(2)=pizda(1,2)+pizda(2,1)
8300 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8303 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8305 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8308 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8309 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8311 ! Cartesian derivatives.
8313 write (2,*) 'In eello6_graph2'
8315 write (2,*) 'iii=',iii
8317 write (2,*) 'kkk=',kkk
8319 write (2,'(3(2f10.5),5x)') &
8320 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8330 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8332 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8335 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
8337 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8338 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
8340 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8341 call transpose2(EUg(1,1,k),auxmat(1,1))
8342 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8344 vv(1)=pizda(1,1)-pizda(2,2)
8345 vv(2)=pizda(1,2)+pizda(2,1)
8346 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8347 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8349 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8351 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8354 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8356 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8362 end function eello6_graph2
8363 !-----------------------------------------------------------------------------
8364 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
8365 ! implicit real*8 (a-h,o-z)
8366 ! include 'DIMENSIONS'
8367 ! include 'COMMON.IOUNITS'
8368 ! include 'COMMON.CHAIN'
8369 ! include 'COMMON.DERIV'
8370 ! include 'COMMON.INTERACT'
8371 ! include 'COMMON.CONTACTS'
8372 ! include 'COMMON.TORSION'
8373 ! include 'COMMON.VAR'
8374 ! include 'COMMON.GEO'
8375 real(kind=8),dimension(2) :: vv,auxvec
8376 real(kind=8),dimension(2,2) :: pizda,auxmat
8378 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
8379 real(kind=8) :: s1,s2,s3,s4
8380 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8382 ! Parallel Antiparallel C
8388 ! j|/k\| / |/k\|l / C
8393 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8395 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
8396 ! energy moment and not to the cluster cumulant.
8397 iti=itortyp(itype(i))
8398 if (j.lt.nres-1) then
8399 itj1=itortyp(itype(j+1))
8403 itk=itortyp(itype(k))
8404 itk1=itortyp(itype(k+1))
8405 if (l.lt.nres-1) then
8406 itl1=itortyp(itype(l+1))
8411 s1=dip(4,jj,i)*dip(4,kk,k)
8413 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8414 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8415 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8416 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8417 call transpose2(EE(1,1,itk),auxmat(1,1))
8418 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8419 vv(1)=pizda(1,1)+pizda(2,2)
8420 vv(2)=pizda(2,1)-pizda(1,2)
8421 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8422 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8423 !d & "sum",-(s2+s3+s4)
8425 eello6_graph3=-(s1+s2+s3+s4)
8427 eello6_graph3=-(s2+s3+s4)
8430 ! Derivatives in gamma(k-1)
8431 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8432 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8433 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8434 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8435 ! Derivatives in gamma(l-1)
8436 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8437 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8438 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8439 vv(1)=pizda(1,1)+pizda(2,2)
8440 vv(2)=pizda(2,1)-pizda(1,2)
8441 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8442 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8443 ! Cartesian derivatives.
8449 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8451 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8454 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8456 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8457 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8459 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8460 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
8462 vv(1)=pizda(1,1)+pizda(2,2)
8463 vv(2)=pizda(2,1)-pizda(1,2)
8464 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8466 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8468 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8471 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8473 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8475 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8480 end function eello6_graph3
8481 !-----------------------------------------------------------------------------
8482 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8483 ! implicit real*8 (a-h,o-z)
8484 ! include 'DIMENSIONS'
8485 ! include 'COMMON.IOUNITS'
8486 ! include 'COMMON.CHAIN'
8487 ! include 'COMMON.DERIV'
8488 ! include 'COMMON.INTERACT'
8489 ! include 'COMMON.CONTACTS'
8490 ! include 'COMMON.TORSION'
8491 ! include 'COMMON.VAR'
8492 ! include 'COMMON.GEO'
8493 ! include 'COMMON.FFIELD'
8494 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
8495 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8497 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
8499 real(kind=8) :: s1,s2,s3,s4
8500 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8502 ! Parallel Antiparallel C
8508 ! \ j|/k\| \ |/k\|l C
8513 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8515 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
8516 ! energy moment and not to the cluster cumulant.
8517 !d write (2,*) 'eello_graph4: wturn6',wturn6
8518 iti=itortyp(itype(i))
8519 itj=itortyp(itype(j))
8520 if (j.lt.nres-1) then
8521 itj1=itortyp(itype(j+1))
8525 itk=itortyp(itype(k))
8526 if (k.lt.nres-1) then
8527 itk1=itortyp(itype(k+1))
8531 itl=itortyp(itype(l))
8532 if (l.lt.nres-1) then
8533 itl1=itortyp(itype(l+1))
8537 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8538 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8539 !d & ' itl',itl,' itl1',itl1
8542 s1=dip(3,jj,i)*dip(3,kk,k)
8544 s1=dip(2,jj,j)*dip(2,kk,l)
8547 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8548 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8550 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8551 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8553 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8554 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8556 call transpose2(EUg(1,1,k),auxmat(1,1))
8557 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8558 vv(1)=pizda(1,1)-pizda(2,2)
8559 vv(2)=pizda(2,1)+pizda(1,2)
8560 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8561 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8563 eello6_graph4=-(s1+s2+s3+s4)
8565 eello6_graph4=-(s2+s3+s4)
8567 ! Derivatives in gamma(i-1)
8571 s1=dipderg(2,jj,i)*dip(3,kk,k)
8573 s1=dipderg(4,jj,j)*dip(2,kk,l)
8576 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8578 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8579 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8581 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8582 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8584 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8585 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8586 !d write (2,*) 'turn6 derivatives'
8588 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8590 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8594 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8596 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8600 ! Derivatives in gamma(k-1)
8603 s1=dip(3,jj,i)*dipderg(2,kk,k)
8605 s1=dip(2,jj,j)*dipderg(4,kk,l)
8608 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8609 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8611 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8612 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8614 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8615 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8617 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8618 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8619 vv(1)=pizda(1,1)-pizda(2,2)
8620 vv(2)=pizda(2,1)+pizda(1,2)
8621 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8622 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8624 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8626 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8630 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8632 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8635 ! Derivatives in gamma(j-1) or gamma(l-1)
8636 if (l.eq.j+1 .and. l.gt.1) then
8637 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8638 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8639 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8640 vv(1)=pizda(1,1)-pizda(2,2)
8641 vv(2)=pizda(2,1)+pizda(1,2)
8642 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8643 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8644 else if (j.gt.1) then
8645 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8646 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8647 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8648 vv(1)=pizda(1,1)-pizda(2,2)
8649 vv(2)=pizda(2,1)+pizda(1,2)
8650 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8651 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8652 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8654 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8657 ! Cartesian derivatives.
8664 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8666 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8670 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8672 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8676 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
8678 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8680 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
8681 b1(1,itj1),auxvec(1))
8682 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8684 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
8685 b1(1,itl1),auxvec(1))
8686 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8688 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
8690 vv(1)=pizda(1,1)-pizda(2,2)
8691 vv(2)=pizda(2,1)+pizda(1,2)
8692 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8694 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8696 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
8699 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
8702 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8705 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8707 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8709 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8713 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8715 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8718 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8720 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8727 end function eello6_graph4
8728 !-----------------------------------------------------------------------------
8729 real(kind=8) function eello_turn6(i,jj,kk)
8730 ! implicit real*8 (a-h,o-z)
8731 ! include 'DIMENSIONS'
8732 ! include 'COMMON.IOUNITS'
8733 ! include 'COMMON.CHAIN'
8734 ! include 'COMMON.DERIV'
8735 ! include 'COMMON.INTERACT'
8736 ! include 'COMMON.CONTACTS'
8737 ! include 'COMMON.TORSION'
8738 ! include 'COMMON.VAR'
8739 ! include 'COMMON.GEO'
8740 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
8741 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
8742 real(kind=8),dimension(3) :: ggg1,ggg2
8743 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
8744 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
8745 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8746 ! the respective energy moment and not to the cluster cumulant.
8748 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
8749 integer :: j1,j2,l1,l2,ll
8750 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
8751 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
8760 iti=itortyp(itype(i))
8761 itk=itortyp(itype(k))
8762 itk1=itortyp(itype(k+1))
8763 itl=itortyp(itype(l))
8764 itj=itortyp(itype(j))
8765 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8766 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
8767 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8772 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8774 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
8778 derx_turn(lll,kkk,iii)=0.0d0
8785 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8787 !d write (2,*) 'eello6_5',eello6_5
8789 call transpose2(AEA(1,1,1),auxmat(1,1))
8790 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8791 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8792 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8794 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8795 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8796 s2 = scalar2(b1(1,itk),vtemp1(1))
8798 call transpose2(AEA(1,1,2),atemp(1,1))
8799 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8800 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8801 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8803 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8804 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8805 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8807 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8808 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8809 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8810 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8811 ss13 = scalar2(b1(1,itk),vtemp4(1))
8812 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8814 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8820 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8821 ! Derivatives in gamma(i+2)
8825 call transpose2(AEA(1,1,1),auxmatd(1,1))
8826 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8827 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8828 call transpose2(AEAderg(1,1,2),atempd(1,1))
8829 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8830 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8832 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8833 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8834 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8840 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8841 ! Derivatives in gamma(i+3)
8843 call transpose2(AEA(1,1,1),auxmatd(1,1))
8844 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8845 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8846 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8848 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8849 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8850 s2d = scalar2(b1(1,itk),vtemp1d(1))
8852 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8853 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8855 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8857 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8858 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8859 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8867 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
8868 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8870 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
8871 -0.5d0*ekont*(s2d+s12d)
8873 ! Derivatives in gamma(i+4)
8874 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8875 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8876 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8878 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8879 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8880 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8888 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8890 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8892 ! Derivatives in gamma(i+5)
8894 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8895 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8896 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8898 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8899 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8900 s2d = scalar2(b1(1,itk),vtemp1d(1))
8902 call transpose2(AEA(1,1,2),atempd(1,1))
8903 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8904 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8906 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8907 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8909 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8910 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8911 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8919 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
8920 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8922 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
8923 -0.5d0*ekont*(s2d+s12d)
8925 ! Cartesian derivatives
8930 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8931 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8932 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8934 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8935 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
8937 s2d = scalar2(b1(1,itk),vtemp1d(1))
8939 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8940 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8941 s8d = -(atempd(1,1)+atempd(2,2))* &
8942 scalar2(cc(1,1,itl),vtemp2(1))
8944 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
8946 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8947 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8954 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
8957 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
8961 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
8964 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
8973 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
8975 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8976 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8977 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8978 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8979 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
8981 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8982 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8983 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8987 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8988 !d & 16*eel_turn6_num
8990 if (j.lt.nres-1) then
8997 if (l.lt.nres-1) then
9005 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
9006 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
9007 !grad ghalf=0.5d0*ggg1(ll)
9009 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9010 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9011 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
9012 +ekont*derx_turn(ll,2,1)
9013 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9014 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
9015 +ekont*derx_turn(ll,4,1)
9016 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9017 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9018 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9019 !grad ghalf=0.5d0*ggg2(ll)
9021 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
9022 +ekont*derx_turn(ll,2,2)
9023 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9024 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
9025 +ekont*derx_turn(ll,4,2)
9026 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9027 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9028 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9033 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9038 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9044 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9049 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9053 !d write (2,*) iii,g_corr6_loc(iii)
9055 eello_turn6=ekont*eel_turn6
9056 !d write (2,*) 'ekont',ekont
9057 !d write (2,*) 'eel_turn6',ekont*eel_turn6
9059 end function eello_turn6
9060 !-----------------------------------------------------------------------------
9061 subroutine MATVEC2(A1,V1,V2)
9062 !DIR$ INLINEALWAYS MATVEC2
9064 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9066 ! implicit real*8 (a-h,o-z)
9067 ! include 'DIMENSIONS'
9068 real(kind=8),dimension(2) :: V1,V2
9069 real(kind=8),dimension(2,2) :: A1
9070 real(kind=8) :: vaux1,vaux2
9074 ! 3 VI=VI+A1(I,K)*V1(K)
9078 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9079 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9083 end subroutine MATVEC2
9084 !-----------------------------------------------------------------------------
9085 subroutine MATMAT2(A1,A2,A3)
9087 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9089 ! implicit real*8 (a-h,o-z)
9090 ! include 'DIMENSIONS'
9091 real(kind=8),dimension(2,2) :: A1,A2,A3
9092 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
9093 ! DIMENSION AI3(2,2)
9097 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
9103 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9104 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9105 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9106 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9112 end subroutine MATMAT2
9113 !-----------------------------------------------------------------------------
9114 real(kind=8) function scalar2(u,v)
9115 !DIR$ INLINEALWAYS scalar2
9117 real(kind=8),dimension(2) :: u,v
9120 scalar2=u(1)*v(1)+u(2)*v(2)
9122 end function scalar2
9123 !-----------------------------------------------------------------------------
9124 subroutine transpose2(a,at)
9125 !DIR$ INLINEALWAYS transpose2
9127 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
9130 real(kind=8),dimension(2,2) :: a,at
9136 end subroutine transpose2
9137 !-----------------------------------------------------------------------------
9138 subroutine transpose(n,a,at)
9141 real(kind=8),dimension(n,n) :: a,at
9148 end subroutine transpose
9149 !-----------------------------------------------------------------------------
9150 subroutine prodmat3(a1,a2,kk,transp,prod)
9151 !DIR$ INLINEALWAYS prodmat3
9153 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
9157 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
9159 !rc double precision auxmat(2,2),prod_(2,2)
9162 !rc call transpose2(kk(1,1),auxmat(1,1))
9163 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9164 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9166 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
9167 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9168 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
9169 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9170 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
9171 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9172 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
9173 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9176 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9177 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9179 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
9180 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9181 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
9182 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9183 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
9184 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9185 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
9186 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9189 ! call transpose2(a2(1,1),a2t(1,1))
9192 !rc print *,((prod_(i,j),i=1,2),j=1,2)
9193 !rc print *,((prod(i,j),i=1,2),j=1,2)
9196 end subroutine prodmat3
9197 !-----------------------------------------------------------------------------
9198 ! energy_p_new_barrier.F
9199 !-----------------------------------------------------------------------------
9200 subroutine sum_gradient
9201 ! implicit real*8 (a-h,o-z)
9202 use io_base, only: pdbout
9203 ! include 'DIMENSIONS'
9207 !MS$ATTRIBUTES C :: proc_proc
9213 real(kind=8),dimension(3,nres) :: gradbufc,gradbufx,gradbufc_sum,&
9214 gloc_scbuf !(3,maxres)
9216 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
9219 integer :: i,j,k,ierror,ierr
9220 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
9221 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
9222 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
9223 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
9224 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
9225 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
9226 gsccorr_max,gsccorrx_max,time00
9228 ! include 'COMMON.SETUP'
9229 ! include 'COMMON.IOUNITS'
9230 ! include 'COMMON.FFIELD'
9231 ! include 'COMMON.DERIV'
9232 ! include 'COMMON.INTERACT'
9233 ! include 'COMMON.SBRIDGE'
9234 ! include 'COMMON.CHAIN'
9235 ! include 'COMMON.VAR'
9236 ! include 'COMMON.CONTROL'
9237 ! include 'COMMON.TIME1'
9238 ! include 'COMMON.MAXGRAD'
9239 ! include 'COMMON.SCCOR'
9244 write (iout,*) "sum_gradient gvdwc, gvdwx"
9246 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9247 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
9257 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
9258 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
9259 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
9262 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
9263 ! in virtual-bond-vector coordinates
9266 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
9268 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
9269 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
9271 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
9273 ! write (iout,'(i5,3f10.5,2x,f10.5)')
9274 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
9276 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
9278 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9279 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
9280 (gvdwc_scpp(j,i),j=1,3)
9282 write (iout,*) "gelc_long gvdwpp gel_loc_long"
9284 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9285 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
9286 (gelc_loc_long(j,i),j=1,3)
9293 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
9294 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
9295 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
9296 wel_loc*gel_loc_long(j,i)+ &
9297 wcorr*gradcorr_long(j,i)+ &
9298 wcorr5*gradcorr5_long(j,i)+ &
9299 wcorr6*gradcorr6_long(j,i)+ &
9300 wturn6*gcorr6_turn_long(j,i)+ &
9307 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
9308 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
9309 welec*gelc_long(j,i)+ &
9311 wel_loc*gel_loc_long(j,i)+ &
9312 wcorr*gradcorr_long(j,i)+ &
9313 wcorr5*gradcorr5_long(j,i)+ &
9314 wcorr6*gradcorr6_long(j,i)+ &
9315 wturn6*gcorr6_turn_long(j,i)+ &
9321 if (nfgtasks.gt.1) then
9324 write (iout,*) "gradbufc before allreduce"
9326 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9332 gradbufc_sum(j,i)=gradbufc(j,i)
9335 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
9336 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
9337 ! time_reduce=time_reduce+MPI_Wtime()-time00
9339 ! write (iout,*) "gradbufc_sum after allreduce"
9341 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
9346 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
9354 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
9355 write (iout,*) (i," jgrad_start",jgrad_start(i),&
9356 " jgrad_end ",jgrad_end(i),&
9357 i=igrad_start,igrad_end)
9360 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
9361 ! do not parallelize this part.
9363 ! do i=igrad_start,igrad_end
9364 ! do j=jgrad_start(i),jgrad_end(i)
9366 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
9371 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
9375 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
9379 write (iout,*) "gradbufc after summing"
9381 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9389 write (iout,*) "gradbufc"
9391 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9398 gradbufc_sum(j,i)=gradbufc(j,i)
9403 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
9407 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
9412 ! gradbufc(k,i)=0.0d0
9416 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
9422 write (iout,*) "gradbufc after summing"
9424 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9433 gradbufc(k,nres)=0.0d0
9436 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
9437 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
9438 !el-----------------
9442 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
9443 wel_loc*gel_loc(j,i)+ &
9444 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
9445 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
9446 wel_loc*gel_loc_long(j,i)+ &
9447 wcorr*gradcorr_long(j,i)+ &
9448 wcorr5*gradcorr5_long(j,i)+ &
9449 wcorr6*gradcorr6_long(j,i)+ &
9450 wturn6*gcorr6_turn_long(j,i))+ &
9452 wcorr*gradcorr(j,i)+ &
9453 wturn3*gcorr3_turn(j,i)+ &
9454 wturn4*gcorr4_turn(j,i)+ &
9455 wcorr5*gradcorr5(j,i)+ &
9456 wcorr6*gradcorr6(j,i)+ &
9457 wturn6*gcorr6_turn(j,i)+ &
9458 wsccor*gsccorc(j,i) &
9461 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
9462 wel_loc*gel_loc(j,i)+ &
9463 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
9464 welec*gelc_long(j,i)+ &
9465 wel_loc*gel_loc_long(j,i)+ &
9466 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
9467 wcorr5*gradcorr5_long(j,i)+ &
9468 wcorr6*gradcorr6_long(j,i)+ &
9469 wturn6*gcorr6_turn_long(j,i))+ &
9471 wcorr*gradcorr(j,i)+ &
9472 wturn3*gcorr3_turn(j,i)+ &
9473 wturn4*gcorr4_turn(j,i)+ &
9474 wcorr5*gradcorr5(j,i)+ &
9475 wcorr6*gradcorr6(j,i)+ &
9476 wturn6*gcorr6_turn(j,i)+ &
9477 wsccor*gsccorc(j,i) &
9480 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
9481 wbond*gradbx(j,i)+ &
9482 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
9483 wsccor*gsccorx(j,i) &
9484 +wscloc*gsclocx(j,i)
9488 write (iout,*) "gloc before adding corr"
9490 write (iout,*) i,gloc(i,icg)
9494 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
9495 +wcorr5*g_corr5_loc(i) &
9496 +wcorr6*g_corr6_loc(i) &
9497 +wturn4*gel_loc_turn4(i) &
9498 +wturn3*gel_loc_turn3(i) &
9499 +wturn6*gel_loc_turn6(i) &
9500 +wel_loc*gel_loc_loc(i)
9503 write (iout,*) "gloc after adding corr"
9505 write (iout,*) i,gloc(i,icg)
9509 if (nfgtasks.gt.1) then
9512 gradbufc(j,i)=gradc(j,i,icg)
9513 gradbufx(j,i)=gradx(j,i,icg)
9517 glocbuf(i)=gloc(i,icg)
9521 write (iout,*) "gloc_sc before reduce"
9524 write (iout,*) i,j,gloc_sc(j,i,icg)
9531 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
9535 call MPI_Barrier(FG_COMM,IERR)
9536 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
9538 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,&
9539 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9540 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,&
9541 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9542 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
9543 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9544 time_reduce=time_reduce+MPI_Wtime()-time00
9545 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
9546 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9547 time_reduce=time_reduce+MPI_Wtime()-time00
9550 write (iout,*) "gloc_sc after reduce"
9553 write (iout,*) i,j,gloc_sc(j,i,icg)
9559 write (iout,*) "gloc after reduce"
9561 write (iout,*) i,gloc(i,icg)
9566 if (gnorm_check) then
9568 ! Compute the maximum elements of the gradient
9578 gcorr3_turn_max=0.0d0
9579 gcorr4_turn_max=0.0d0
9582 gcorr6_turn_max=0.0d0
9592 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
9593 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
9594 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
9595 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
9596 gvdwc_scp_max=gvdwc_scp_norm
9597 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
9598 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
9599 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
9600 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
9601 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
9602 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
9603 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
9604 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
9605 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
9606 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
9607 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
9608 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
9609 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
9611 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
9612 gcorr3_turn_max=gcorr3_turn_norm
9613 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
9615 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
9616 gcorr4_turn_max=gcorr4_turn_norm
9617 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
9618 if (gradcorr5_norm.gt.gradcorr5_max) &
9619 gradcorr5_max=gradcorr5_norm
9620 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
9621 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
9622 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
9624 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
9625 gcorr6_turn_max=gcorr6_turn_norm
9626 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
9627 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
9628 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
9629 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
9630 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
9631 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
9632 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
9633 if (gradx_scp_norm.gt.gradx_scp_max) &
9634 gradx_scp_max=gradx_scp_norm
9635 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
9636 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
9637 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
9638 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
9639 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
9640 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
9641 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
9642 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
9646 open(istat,file=statname,position="append")
9648 open(istat,file=statname,access="append")
9650 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
9651 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
9652 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
9653 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
9654 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
9655 gsccorx_max,gsclocx_max
9657 if (gvdwc_max.gt.1.0d4) then
9658 write (iout,*) "gvdwc gvdwx gradb gradbx"
9660 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
9661 gradb(j,i),gradbx(j,i),j=1,3)
9663 call pdbout(0.0d0,'cipiszcze',iout)
9670 write (iout,*) "gradc gradx gloc"
9672 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
9673 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
9678 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
9681 end subroutine sum_gradient
9682 !-----------------------------------------------------------------------------
9684 ! implicit real*8 (a-h,o-z)
9686 ! include 'DIMENSIONS'
9687 ! include 'COMMON.CHAIN'
9688 ! include 'COMMON.DERIV'
9689 ! include 'COMMON.CALC'
9690 ! include 'COMMON.IOUNITS'
9691 real(kind=8), dimension(3) :: dcosom1,dcosom2
9693 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
9694 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
9695 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
9696 -2.0D0*alf12*eps3der+sigder*sigsq_om12
9700 ! eom12=evdwij*eps1_om12
9702 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
9704 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
9705 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
9706 !C print *,sss_ele_cut,'in sc_grad'
9708 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
9709 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
9712 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
9713 !C print *,'gg',k,gg(k)
9715 ! write (iout,*) "gg",(gg(k),k=1,3)
9717 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
9718 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
9719 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
9722 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
9723 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
9724 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
9727 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
9728 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
9729 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
9730 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
9733 ! Calculate the components of the gradient in DC and X
9737 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
9741 gvdwc(l,i)=gvdwc(l,i)-gg(l)
9742 gvdwc(l,j)=gvdwc(l,j)+gg(l)
9745 end subroutine sc_grad
9747 !-----------------------------------------------------------------------------
9748 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
9751 ! implicit real*8 (a-h,o-z)
9752 ! include 'DIMENSIONS'
9753 ! include 'COMMON.LOCAL'
9754 ! include 'COMMON.IOUNITS'
9755 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
9756 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
9757 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
9758 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
9759 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
9761 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
9762 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
9763 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
9766 delthec=thetai-thet_pred_mean
9767 delthe0=thetai-theta0i
9768 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
9769 t3 = thetai-thet_pred_mean
9773 t14 = t12+t6*sigsqtc
9775 t21 = thetai-theta0i
9781 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
9782 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
9783 *(-t12*t9-ak*sig0inv*t27)
9785 end subroutine mixder
9787 !-----------------------------------------------------------------------------
9789 !-----------------------------------------------------------------------------
9791 !-----------------------------------------------------------------------------
9792 ! This subroutine calculates the derivatives of the consecutive virtual
9793 ! bond vectors and the SC vectors in the virtual-bond angles theta and
9794 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
9795 ! in the angles alpha and omega, describing the location of a side chain
9796 ! in its local coordinate system.
9798 ! The derivatives are stored in the following arrays:
9800 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
9801 ! The structure is as follows:
9803 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
9804 ! 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)
9805 ! . . . . . . . . . . . . . . . . . .
9806 ! 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)
9810 ! 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)
9812 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
9813 ! The structure is same as above.
9815 ! DCDS - the derivatives of the side chain vectors in the local spherical
9816 ! andgles alph and omega:
9818 ! 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)
9819 ! 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)
9823 ! 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)
9825 ! Version of March '95, based on an early version of November '91.
9827 !**********************************************************************
9828 ! implicit real*8 (a-h,o-z)
9829 ! include 'DIMENSIONS'
9830 ! include 'COMMON.VAR'
9831 ! include 'COMMON.CHAIN'
9832 ! include 'COMMON.DERIV'
9833 ! include 'COMMON.GEO'
9834 ! include 'COMMON.LOCAL'
9835 ! include 'COMMON.INTERACT'
9836 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
9837 real(kind=8),dimension(3,3) :: dp,temp
9838 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
9839 real(kind=8),dimension(3) :: xx,xx1
9841 integer :: i,k,l,j,m,ind,ind1,jjj
9842 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
9843 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
9844 sint2,xp,yp,xxp,yyp,zzp,dj
9846 ! common /przechowalnia/ fromto
9847 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
9848 ! get the position of the jth ijth fragment of the chain coordinate system
9849 ! in the fromto array.
9850 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
9852 ! maxdim=(nres-1)*(nres-2)/2
9853 ! allocate(dcdv(6,maxdim),dxds(6,nres))
9854 ! calculate the derivatives of transformation matrix elements in theta
9857 !el call flush(iout) !el
9859 rdt(1,1,i)=-rt(1,2,i)
9860 rdt(1,2,i)= rt(1,1,i)
9862 rdt(2,1,i)=-rt(2,2,i)
9863 rdt(2,2,i)= rt(2,1,i)
9865 rdt(3,1,i)=-rt(3,2,i)
9866 rdt(3,2,i)= rt(3,1,i)
9870 ! derivatives in phi
9876 drt(2,1,i)= rt(3,1,i)
9877 drt(2,2,i)= rt(3,2,i)
9878 drt(2,3,i)= rt(3,3,i)
9879 drt(3,1,i)=-rt(2,1,i)
9880 drt(3,2,i)=-rt(2,2,i)
9881 drt(3,3,i)=-rt(2,3,i)
9884 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
9895 fromto(k,l,ind)=temp(k,l)
9904 dpkl=dpkl+temp(k,m)*rt(m,l,j)
9907 fromto(k,l,ind)=dpkl
9918 ! Calculate derivatives.
9924 ! Derivatives of DC(i+1) in theta(i+2)
9930 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
9933 prordt(j,k,i)=dp(j,k)
9936 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
9939 ! Derivatives of SC(i+1) in theta(i+2)
9941 xx1(1)=-0.5D0*xloc(2,i+1)
9942 xx1(2)= 0.5D0*xloc(1,i+1)
9946 xj=xj+r(j,k,i)*xx1(k)
9953 rj=rj+prod(j,k,i)*xx(k)
9958 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
9959 ! than the other off-diagonal derivatives.
9964 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
9966 dxdv(j,ind1+1)=dxoiij
9968 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
9970 ! Derivatives of DC(i+1) in phi(i+2)
9976 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
9979 prodrt(j,k,i)=dp(j,k)
9981 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
9984 ! Derivatives of SC(i+1) in phi(i+2)
9987 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
9988 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
9992 rj=rj+prod(j,k,i)*xx(k)
9997 ! Derivatives of SC(i+1) in phi(i+3).
10002 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
10004 dxdv(j+3,ind1+1)=dxoiij
10007 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
10008 ! theta(nres) and phi(i+3) thru phi(nres).
10012 ind=indmat(i+1,j+1)
10013 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
10018 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
10023 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
10024 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
10025 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
10026 ! Derivatives of virtual-bond vectors in theta
10028 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
10030 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
10031 ! Derivatives of SC vectors in theta
10035 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
10037 dxdv(k,ind1+1)=dxoijk
10040 !--- Calculate the derivatives in phi
10046 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
10052 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
10057 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
10059 dxdv(k+3,ind1+1)=dxoijk
10064 ! Derivatives in alpha and omega:
10067 ! dsci=dsc(itype(i))
10072 if(alphi.ne.alphi) alphi=100.0
10073 if(omegi.ne.omegi) omegi=-100.0
10078 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
10079 cosalphi=dcos(alphi)
10080 sinalphi=dsin(alphi)
10081 cosomegi=dcos(omegi)
10082 sinomegi=dsin(omegi)
10083 temp(1,1)=-dsci*sinalphi
10084 temp(2,1)= dsci*cosalphi*cosomegi
10085 temp(3,1)=-dsci*cosalphi*sinomegi
10087 temp(2,2)=-dsci*sinalphi*sinomegi
10088 temp(3,2)=-dsci*sinalphi*cosomegi
10089 theta2=pi-0.5D0*theta(i+1)
10093 !d print *,((temp(l,k),l=1,3),k=1,2)
10097 xxp= xp*cost2+yp*sint2
10098 yyp=-xp*sint2+yp*cost2
10101 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
10102 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
10106 dj=dj+prod(k,l,i-1)*xx(l)
10114 end subroutine cartder
10115 !-----------------------------------------------------------------------------
10117 !-----------------------------------------------------------------------------
10118 subroutine check_cartgrad
10119 ! Check the gradient of Cartesian coordinates in internal coordinates.
10120 ! implicit real*8 (a-h,o-z)
10121 ! include 'DIMENSIONS'
10122 ! include 'COMMON.IOUNITS'
10123 ! include 'COMMON.VAR'
10124 ! include 'COMMON.CHAIN'
10125 ! include 'COMMON.GEO'
10126 ! include 'COMMON.LOCAL'
10127 ! include 'COMMON.DERIV'
10128 real(kind=8),dimension(6,nres) :: temp
10129 real(kind=8),dimension(3) :: xx,gg
10130 integer :: i,k,j,ii
10131 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
10132 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
10134 ! Check the gradient of the virtual-bond and SC vectors in the internal
10140 write (iout,'(a)') '**************** dx/dalpha'
10144 alph(i)=alph(i)+aincr
10146 temp(k,i)=dc(k,nres+i)
10150 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
10151 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
10153 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
10154 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
10160 write (iout,'(a)') '**************** dx/domega'
10164 omeg(i)=omeg(i)+aincr
10166 temp(k,i)=dc(k,nres+i)
10170 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
10171 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
10172 (aincr*dabs(dxds(k+3,i))+aincr))
10174 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
10175 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
10181 write (iout,'(a)') '**************** dx/dtheta'
10185 theta(i)=theta(i)+aincr
10188 temp(k,j)=dc(k,nres+j)
10194 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
10196 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
10197 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
10198 (aincr*dabs(dxdv(k,ii))+aincr))
10200 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10201 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
10208 write (iout,'(a)') '***************** dx/dphi'
10211 phi(i)=phi(i)+aincr
10214 temp(k,j)=dc(k,nres+j)
10222 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
10223 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
10224 (aincr*dabs(dxdv(k+3,ii))+aincr))
10226 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10227 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
10230 phi(i)=phi(i)-aincr
10233 write (iout,'(a)') '****************** ddc/dtheta'
10236 theta(i+2)=thet+aincr
10247 gg(k)=(dc(k,j)-temp(k,j))/aincr
10248 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
10249 (aincr*dabs(dcdv(k,ii))+aincr))
10251 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10252 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
10262 write (iout,'(a)') '******************* ddc/dphi'
10265 phi(i+3)=phii+aincr
10276 gg(k)=(dc(k,j)-temp(k,j))/aincr
10277 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
10278 (aincr*dabs(dcdv(k+3,ii))+aincr))
10280 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10281 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
10292 end subroutine check_cartgrad
10293 !-----------------------------------------------------------------------------
10294 subroutine check_ecart
10295 ! Check the gradient of the energy in Cartesian coordinates.
10296 ! implicit real*8 (a-h,o-z)
10297 ! include 'DIMENSIONS'
10298 ! include 'COMMON.CHAIN'
10299 ! include 'COMMON.DERIV'
10300 ! include 'COMMON.IOUNITS'
10301 ! include 'COMMON.VAR'
10302 ! include 'COMMON.CONTACTS'
10304 !el integer :: icall
10305 !el common /srutu/ icall
10306 real(kind=8),dimension(6) :: ggg
10307 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
10308 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10309 real(kind=8),dimension(6,nres) :: grad_s
10310 real(kind=8),dimension(0:n_ene) :: energia,energia1
10311 integer :: uiparm(1)
10312 real(kind=8) :: urparm(1)
10314 integer :: nf,i,j,k
10315 real(kind=8) :: aincr,etot,etot1
10321 print '(a)','CG processor',me,' calling CHECK_CART.'
10324 call geom_to_var(nvar,x)
10325 call etotal(energia)
10327 !el call enerprint(energia)
10328 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
10331 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10335 grad_s(j,i)=gradc(j,i,icg)
10336 grad_s(j+3,i)=gradx(j,i,icg)
10340 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10345 ddx(j)=dc(j,i+nres)
10348 dc(j,i)=dc(j,i)+aincr
10350 c(j,k)=c(j,k)+aincr
10351 c(j,k+nres)=c(j,k+nres)+aincr
10353 call etotal(energia1)
10355 ggg(j)=(etot1-etot)/aincr
10358 c(j,k)=c(j,k)-aincr
10359 c(j,k+nres)=c(j,k+nres)-aincr
10363 c(j,i+nres)=c(j,i+nres)+aincr
10364 dc(j,i+nres)=dc(j,i+nres)+aincr
10365 call etotal(energia1)
10367 ggg(j+3)=(etot1-etot)/aincr
10369 dc(j,i+nres)=ddx(j)
10371 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
10372 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
10375 end subroutine check_ecart
10377 !-----------------------------------------------------------------------------
10378 subroutine check_ecartint
10379 ! Check the gradient of the energy in Cartesian coordinates.
10380 use io_base, only: intout
10381 ! implicit real*8 (a-h,o-z)
10382 ! include 'DIMENSIONS'
10383 ! include 'COMMON.CONTROL'
10384 ! include 'COMMON.CHAIN'
10385 ! include 'COMMON.DERIV'
10386 ! include 'COMMON.IOUNITS'
10387 ! include 'COMMON.VAR'
10388 ! include 'COMMON.CONTACTS'
10389 ! include 'COMMON.MD'
10390 ! include 'COMMON.LOCAL'
10391 ! include 'COMMON.SPLITELE'
10393 !el integer :: icall
10394 !el common /srutu/ icall
10395 real(kind=8),dimension(6) :: ggg,ggg1
10396 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
10397 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10398 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
10399 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
10400 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
10401 real(kind=8),dimension(0:n_ene) :: energia,energia1
10402 integer :: uiparm(1)
10403 real(kind=8) :: urparm(1)
10405 integer :: i,j,k,nf
10406 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
10414 ! call intcartderiv
10415 ! call checkintcartgrad
10418 write(iout,*) 'Calling CHECK_ECARTINT.'
10421 write (iout,*) "Before geom_to_var"
10422 call geom_to_var(nvar,x)
10423 write (iout,*) "after geom_to_var"
10424 write (iout,*) "split_ene ",split_ene
10426 if (.not.split_ene) then
10427 write(iout,*) 'Calling CHECK_ECARTINT if'
10428 call etotal(energia)
10429 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
10431 write (iout,*) "etot",etot
10433 !el call enerprint(energia)
10434 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
10436 write (iout,*) "enter cartgrad"
10439 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
10440 write (iout,*) "exit cartgrad"
10444 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10447 grad_s(j,0)=gcart(j,0)
10449 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
10452 grad_s(j,i)=gcart(j,i)
10453 grad_s(j+3,i)=gxcart(j,i)
10457 write(iout,*) 'Calling CHECK_ECARTIN else.'
10458 !- split gradient check
10460 call etotal_long(energia)
10461 !el call enerprint(energia)
10463 write (iout,*) "enter cartgrad"
10466 write (iout,*) "exit cartgrad"
10469 write (iout,*) "longrange grad"
10471 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10472 (gxcart(j,i),j=1,3)
10475 grad_s(j,0)=gcart(j,0)
10479 grad_s(j,i)=gcart(j,i)
10480 grad_s(j+3,i)=gxcart(j,i)
10484 call etotal_short(energia)
10485 !el call enerprint(energia)
10487 write (iout,*) "enter cartgrad"
10490 write (iout,*) "exit cartgrad"
10493 write (iout,*) "shortrange grad"
10495 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10496 (gxcart(j,i),j=1,3)
10499 grad_s1(j,0)=gcart(j,0)
10503 grad_s1(j,i)=gcart(j,i)
10504 grad_s1(j+3,i)=gxcart(j,i)
10508 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10512 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
10513 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
10516 dcnorm_safe1(j)=dc_norm(j,i-1)
10517 dcnorm_safe2(j)=dc_norm(j,i)
10518 dxnorm_safe(j)=dc_norm(j,i+nres)
10521 c(j,i)=ddc(j)+aincr
10522 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
10523 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
10524 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
10525 dc(j,i)=c(j,i+1)-c(j,i)
10526 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10527 call int_from_cart1(.false.)
10528 if (.not.split_ene) then
10529 call etotal(energia1)
10531 write (iout,*) "ij",i,j," etot1",etot1
10534 call etotal_long(energia1)
10536 call etotal_short(energia1)
10539 !- end split gradient
10540 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10541 c(j,i)=ddc(j)-aincr
10542 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
10543 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
10544 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
10545 dc(j,i)=c(j,i+1)-c(j,i)
10546 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10547 call int_from_cart1(.false.)
10548 if (.not.split_ene) then
10549 call etotal(energia1)
10551 write (iout,*) "ij",i,j," etot2",etot2
10552 ggg(j)=(etot1-etot2)/(2*aincr)
10555 call etotal_long(energia1)
10557 ggg(j)=(etot11-etot21)/(2*aincr)
10558 call etotal_short(energia1)
10560 ggg1(j)=(etot12-etot22)/(2*aincr)
10561 !- end split gradient
10562 ! write (iout,*) "etot21",etot21," etot22",etot22
10564 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10566 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
10567 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
10568 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
10569 dc(j,i)=c(j,i+1)-c(j,i)
10570 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10571 dc_norm(j,i-1)=dcnorm_safe1(j)
10572 dc_norm(j,i)=dcnorm_safe2(j)
10573 dc_norm(j,i+nres)=dxnorm_safe(j)
10576 c(j,i+nres)=ddx(j)+aincr
10577 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10578 call int_from_cart1(.false.)
10579 if (.not.split_ene) then
10580 call etotal(energia1)
10584 call etotal_long(energia1)
10586 call etotal_short(energia1)
10589 !- end split gradient
10590 c(j,i+nres)=ddx(j)-aincr
10591 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10592 call int_from_cart1(.false.)
10593 if (.not.split_ene) then
10594 call etotal(energia1)
10596 ggg(j+3)=(etot1-etot2)/(2*aincr)
10599 call etotal_long(energia1)
10601 ggg(j+3)=(etot11-etot21)/(2*aincr)
10602 call etotal_short(energia1)
10604 ggg1(j+3)=(etot12-etot22)/(2*aincr)
10605 !- end split gradient
10607 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10609 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10610 dc_norm(j,i+nres)=dxnorm_safe(j)
10611 call int_from_cart1(.false.)
10613 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10614 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
10615 if (split_ene) then
10616 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10617 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
10619 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10620 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
10621 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
10625 end subroutine check_ecartint
10627 !-----------------------------------------------------------------------------
10628 subroutine check_ecartint
10629 ! Check the gradient of the energy in Cartesian coordinates.
10630 use io_base, only: intout
10631 ! implicit real*8 (a-h,o-z)
10632 ! include 'DIMENSIONS'
10633 ! include 'COMMON.CONTROL'
10634 ! include 'COMMON.CHAIN'
10635 ! include 'COMMON.DERIV'
10636 ! include 'COMMON.IOUNITS'
10637 ! include 'COMMON.VAR'
10638 ! include 'COMMON.CONTACTS'
10639 ! include 'COMMON.MD'
10640 ! include 'COMMON.LOCAL'
10641 ! include 'COMMON.SPLITELE'
10643 !el integer :: icall
10644 !el common /srutu/ icall
10645 real(kind=8),dimension(6) :: ggg,ggg1
10646 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
10647 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10648 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
10649 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
10650 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
10651 real(kind=8),dimension(0:n_ene) :: energia,energia1
10652 integer :: uiparm(1)
10653 real(kind=8) :: urparm(1)
10655 integer :: i,j,k,nf
10656 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
10664 ! call intcartderiv
10665 ! call checkintcartgrad
10668 write(iout,*) 'Calling CHECK_ECARTINT.'
10671 call geom_to_var(nvar,x)
10672 if (.not.split_ene) then
10673 call etotal(energia)
10675 !el call enerprint(energia)
10677 write (iout,*) "enter cartgrad"
10680 write (iout,*) "exit cartgrad"
10684 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10687 grad_s(j,0)=gcart(j,0)
10691 grad_s(j,i)=gcart(j,i)
10692 grad_s(j+3,i)=gxcart(j,i)
10696 !- split gradient check
10698 call etotal_long(energia)
10699 !el call enerprint(energia)
10701 write (iout,*) "enter cartgrad"
10704 write (iout,*) "exit cartgrad"
10707 write (iout,*) "longrange grad"
10709 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10710 (gxcart(j,i),j=1,3)
10713 grad_s(j,0)=gcart(j,0)
10717 grad_s(j,i)=gcart(j,i)
10718 grad_s(j+3,i)=gxcart(j,i)
10722 call etotal_short(energia)
10723 !el call enerprint(energia)
10725 write (iout,*) "enter cartgrad"
10728 write (iout,*) "exit cartgrad"
10731 write (iout,*) "shortrange grad"
10733 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10734 (gxcart(j,i),j=1,3)
10737 grad_s1(j,0)=gcart(j,0)
10741 grad_s1(j,i)=gcart(j,i)
10742 grad_s1(j+3,i)=gxcart(j,i)
10746 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10751 ddx(j)=dc(j,i+nres)
10753 dcnorm_safe(k)=dc_norm(k,i)
10754 dxnorm_safe(k)=dc_norm(k,i+nres)
10758 dc(j,i)=ddc(j)+aincr
10759 call chainbuild_cart
10761 ! Broadcast the order to compute internal coordinates to the slaves.
10762 ! if (nfgtasks.gt.1)
10763 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
10765 ! call int_from_cart1(.false.)
10766 if (.not.split_ene) then
10767 call etotal(energia1)
10771 call etotal_long(energia1)
10773 call etotal_short(energia1)
10775 ! write (iout,*) "etot11",etot11," etot12",etot12
10777 !- end split gradient
10778 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10779 dc(j,i)=ddc(j)-aincr
10780 call chainbuild_cart
10781 ! call int_from_cart1(.false.)
10782 if (.not.split_ene) then
10783 call etotal(energia1)
10785 ggg(j)=(etot1-etot2)/(2*aincr)
10788 call etotal_long(energia1)
10790 ggg(j)=(etot11-etot21)/(2*aincr)
10791 call etotal_short(energia1)
10793 ggg1(j)=(etot12-etot22)/(2*aincr)
10794 !- end split gradient
10795 ! write (iout,*) "etot21",etot21," etot22",etot22
10797 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10799 call chainbuild_cart
10802 dc(j,i+nres)=ddx(j)+aincr
10803 call chainbuild_cart
10804 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
10805 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
10806 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
10807 ! write (iout,*) "dxnormnorm",dsqrt(
10808 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
10809 ! write (iout,*) "dxnormnormsafe",dsqrt(
10810 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
10812 if (.not.split_ene) then
10813 call etotal(energia1)
10817 call etotal_long(energia1)
10819 call etotal_short(energia1)
10822 !- end split gradient
10823 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10824 dc(j,i+nres)=ddx(j)-aincr
10825 call chainbuild_cart
10826 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
10827 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
10828 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
10830 ! write (iout,*) "dxnormnorm",dsqrt(
10831 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
10832 ! write (iout,*) "dxnormnormsafe",dsqrt(
10833 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
10834 if (.not.split_ene) then
10835 call etotal(energia1)
10837 ggg(j+3)=(etot1-etot2)/(2*aincr)
10840 call etotal_long(energia1)
10842 ggg(j+3)=(etot11-etot21)/(2*aincr)
10843 call etotal_short(energia1)
10845 ggg1(j+3)=(etot12-etot22)/(2*aincr)
10846 !- end split gradient
10848 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10849 dc(j,i+nres)=ddx(j)
10850 call chainbuild_cart
10852 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10853 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
10854 if (split_ene) then
10855 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10856 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
10858 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10859 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
10860 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
10864 end subroutine check_ecartint
10866 !-----------------------------------------------------------------------------
10867 subroutine check_eint
10868 ! Check the gradient of energy in internal coordinates.
10869 ! implicit real*8 (a-h,o-z)
10870 ! include 'DIMENSIONS'
10871 ! include 'COMMON.CHAIN'
10872 ! include 'COMMON.DERIV'
10873 ! include 'COMMON.IOUNITS'
10874 ! include 'COMMON.VAR'
10875 ! include 'COMMON.GEO'
10877 !el integer :: icall
10878 !el common /srutu/ icall
10879 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
10880 integer :: uiparm(1)
10881 real(kind=8) :: urparm(1)
10882 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
10883 character(len=6) :: key
10886 real(kind=8) :: xi,aincr,etot,etot1,etot2
10889 print '(a)','Calling CHECK_INT.'
10893 call geom_to_var(nvar,x)
10894 call var_to_geom(nvar,x)
10898 call etotal(energia)
10900 !el call enerprint(energia)
10903 if (MyID.ne.BossID) then
10904 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
10912 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
10913 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
10914 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
10918 x(i)=xi-0.5D0*aincr
10919 call var_to_geom(nvar,x)
10921 call etotal(energia1)
10923 x(i)=xi+0.5D0*aincr
10924 call var_to_geom(nvar,x)
10926 call etotal(energia2)
10928 gg(i)=(etot2-etot1)/aincr
10929 write (iout,*) i,etot1,etot2
10932 write (iout,'(/2a)')' Variable Numerical Analytical',&
10935 if (i.le.nphi) then
10938 else if (i.le.nphi+ntheta) then
10941 else if (i.le.nphi+ntheta+nside) then
10945 ii=i-(nphi+ntheta+nside)
10948 write (iout,'(i3,a,i3,3(1pd16.6))') &
10949 i,key,ii,gg(i),gana(i),&
10950 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
10953 end subroutine check_eint
10954 !-----------------------------------------------------------------------------
10956 !-----------------------------------------------------------------------------
10957 subroutine Econstr_back
10958 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
10959 ! implicit real*8 (a-h,o-z)
10960 ! include 'DIMENSIONS'
10961 ! include 'COMMON.CONTROL'
10962 ! include 'COMMON.VAR'
10963 ! include 'COMMON.MD'
10966 ! include 'COMMON.LANGEVIN'
10968 ! include 'COMMON.LANGEVIN.lang0'
10970 ! include 'COMMON.CHAIN'
10971 ! include 'COMMON.DERIV'
10972 ! include 'COMMON.GEO'
10973 ! include 'COMMON.LOCAL'
10974 ! include 'COMMON.INTERACT'
10975 ! include 'COMMON.IOUNITS'
10976 ! include 'COMMON.NAMES'
10977 ! include 'COMMON.TIME1'
10978 integer :: i,j,ii,k
10979 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
10981 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
10982 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
10983 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
10990 duscdiff(j,i)=0.0d0
10991 duscdiffx(j,i)=0.0d0
10995 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
10997 ! Deviations from theta angles
11000 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
11001 dtheta_i=theta(j)-thetaref(j)
11002 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
11003 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
11005 utheta(i)=utheta_i/(ii-1)
11007 ! Deviations from gamma angles
11010 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
11011 dgamma_i=pinorm(phi(j)-phiref(j))
11012 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
11013 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
11014 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
11015 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
11017 ugamma(i)=ugamma_i/(ii-2)
11019 ! Deviations from local SC geometry
11022 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
11023 dxx=xxtab(j)-xxref(j)
11024 dyy=yytab(j)-yyref(j)
11025 dzz=zztab(j)-zzref(j)
11026 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
11028 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
11029 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
11031 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
11032 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
11034 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
11035 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
11038 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
11039 ! & xxref(j),yyref(j),zzref(j)
11041 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
11042 ! write (iout,*) i," uscdiff",uscdiff(i)
11044 ! Put together deviations from local geometry
11046 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
11047 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
11048 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
11049 ! & " uconst_back",uconst_back
11050 utheta(i)=dsqrt(utheta(i))
11051 ugamma(i)=dsqrt(ugamma(i))
11052 uscdiff(i)=dsqrt(uscdiff(i))
11055 end subroutine Econstr_back
11056 !-----------------------------------------------------------------------------
11057 ! energy_p_new-sep_barrier.F
11058 !-----------------------------------------------------------------------------
11059 real(kind=8) function sscale(r)
11060 ! include "COMMON.SPLITELE"
11061 real(kind=8) :: r,gamm
11062 if(r.lt.r_cut-rlamb) then
11064 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
11065 gamm=(r-(r_cut-rlamb))/rlamb
11066 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
11071 end function sscale
11072 real(kind=8) function sscale_grad(r)
11073 ! include "COMMON.SPLITELE"
11074 real(kind=8) :: r,gamm
11075 if(r.lt.r_cut-rlamb) then
11077 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
11078 gamm=(r-(r_cut-rlamb))/rlamb
11079 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
11084 end function sscale_grad
11086 !!!!!!!!!! PBCSCALE
11087 real(kind=8) function sscale_ele(r)
11088 ! include "COMMON.SPLITELE"
11089 real(kind=8) :: r,gamm
11090 if(r.lt.r_cut_ele-rlamb_ele) then
11092 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
11093 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
11094 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
11099 end function sscale_ele
11101 real(kind=8) function sscagrad_ele(r)
11102 real(kind=8) :: r,gamm
11103 ! include "COMMON.SPLITELE"
11104 if(r.lt.r_cut_ele-rlamb_ele) then
11106 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
11107 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
11108 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
11113 end function sscagrad_ele
11115 !-----------------------------------------------------------------------------
11116 subroutine elj_long(evdw)
11118 ! This subroutine calculates the interaction energy of nonbonded side chains
11119 ! assuming the LJ potential of interaction.
11121 ! implicit real*8 (a-h,o-z)
11122 ! include 'DIMENSIONS'
11123 ! include 'COMMON.GEO'
11124 ! include 'COMMON.VAR'
11125 ! include 'COMMON.LOCAL'
11126 ! include 'COMMON.CHAIN'
11127 ! include 'COMMON.DERIV'
11128 ! include 'COMMON.INTERACT'
11129 ! include 'COMMON.TORSION'
11130 ! include 'COMMON.SBRIDGE'
11131 ! include 'COMMON.NAMES'
11132 ! include 'COMMON.IOUNITS'
11133 ! include 'COMMON.CONTACTS'
11134 real(kind=8),parameter :: accur=1.0d-10
11135 real(kind=8),dimension(3) :: gg
11136 !el local variables
11137 integer :: i,iint,j,k,itypi,itypi1,itypj
11138 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
11139 real(kind=8) :: e1,e2,evdwij,evdw
11140 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
11142 do i=iatsc_s,iatsc_e
11144 if (itypi.eq.ntyp1) cycle
11150 ! Calculate SC interaction energy.
11152 do iint=1,nint_gr(i)
11153 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
11154 !d & 'iend=',iend(i,iint)
11155 do j=istart(i,iint),iend(i,iint)
11157 if (itypj.eq.ntyp1) cycle
11161 rij=xj*xj+yj*yj+zj*zj
11162 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
11163 if (sss.lt.1.0d0) then
11165 eps0ij=eps(itypi,itypj)
11167 e1=fac*fac*aa(itypi,itypj)
11168 e2=fac*bb(itypi,itypj)
11170 evdw=evdw+(1.0d0-sss)*evdwij
11172 ! Calculate the components of the gradient in DC and X
11174 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
11179 gvdwx(k,i)=gvdwx(k,i)-gg(k)
11180 gvdwx(k,j)=gvdwx(k,j)+gg(k)
11181 gvdwc(k,i)=gvdwc(k,i)-gg(k)
11182 gvdwc(k,j)=gvdwc(k,j)+gg(k)
11190 gvdwc(j,i)=expon*gvdwc(j,i)
11191 gvdwx(j,i)=expon*gvdwx(j,i)
11194 !******************************************************************************
11198 ! To save time, the factor of EXPON has been extracted from ALL components
11199 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
11202 !******************************************************************************
11204 end subroutine elj_long
11205 !-----------------------------------------------------------------------------
11206 subroutine elj_short(evdw)
11208 ! This subroutine calculates the interaction energy of nonbonded side chains
11209 ! assuming the LJ potential of interaction.
11211 ! implicit real*8 (a-h,o-z)
11212 ! include 'DIMENSIONS'
11213 ! include 'COMMON.GEO'
11214 ! include 'COMMON.VAR'
11215 ! include 'COMMON.LOCAL'
11216 ! include 'COMMON.CHAIN'
11217 ! include 'COMMON.DERIV'
11218 ! include 'COMMON.INTERACT'
11219 ! include 'COMMON.TORSION'
11220 ! include 'COMMON.SBRIDGE'
11221 ! include 'COMMON.NAMES'
11222 ! include 'COMMON.IOUNITS'
11223 ! include 'COMMON.CONTACTS'
11224 real(kind=8),parameter :: accur=1.0d-10
11225 real(kind=8),dimension(3) :: gg
11226 !el local variables
11227 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
11228 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
11229 real(kind=8) :: e1,e2,evdwij,evdw
11230 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
11232 do i=iatsc_s,iatsc_e
11234 if (itypi.eq.ntyp1) cycle
11242 ! Calculate SC interaction energy.
11244 do iint=1,nint_gr(i)
11245 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
11246 !d & 'iend=',iend(i,iint)
11247 do j=istart(i,iint),iend(i,iint)
11249 if (itypj.eq.ntyp1) cycle
11253 ! Change 12/1/95 to calculate four-body interactions
11254 rij=xj*xj+yj*yj+zj*zj
11255 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
11256 if (sss.gt.0.0d0) then
11258 eps0ij=eps(itypi,itypj)
11260 e1=fac*fac*aa(itypi,itypj)
11261 e2=fac*bb(itypi,itypj)
11263 evdw=evdw+sss*evdwij
11265 ! Calculate the components of the gradient in DC and X
11267 fac=-rrij*(e1+evdwij)*sss
11272 gvdwx(k,i)=gvdwx(k,i)-gg(k)
11273 gvdwx(k,j)=gvdwx(k,j)+gg(k)
11274 gvdwc(k,i)=gvdwc(k,i)-gg(k)
11275 gvdwc(k,j)=gvdwc(k,j)+gg(k)
11283 gvdwc(j,i)=expon*gvdwc(j,i)
11284 gvdwx(j,i)=expon*gvdwx(j,i)
11287 !******************************************************************************
11291 ! To save time, the factor of EXPON has been extracted from ALL components
11292 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
11295 !******************************************************************************
11297 end subroutine elj_short
11298 !-----------------------------------------------------------------------------
11299 subroutine eljk_long(evdw)
11301 ! This subroutine calculates the interaction energy of nonbonded side chains
11302 ! assuming the LJK potential of interaction.
11304 ! implicit real*8 (a-h,o-z)
11305 ! include 'DIMENSIONS'
11306 ! include 'COMMON.GEO'
11307 ! include 'COMMON.VAR'
11308 ! include 'COMMON.LOCAL'
11309 ! include 'COMMON.CHAIN'
11310 ! include 'COMMON.DERIV'
11311 ! include 'COMMON.INTERACT'
11312 ! include 'COMMON.IOUNITS'
11313 ! include 'COMMON.NAMES'
11314 real(kind=8),dimension(3) :: gg
11316 !el local variables
11317 integer :: i,iint,j,k,itypi,itypi1,itypj
11318 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
11319 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
11320 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
11322 do i=iatsc_s,iatsc_e
11324 if (itypi.eq.ntyp1) cycle
11330 ! Calculate SC interaction energy.
11332 do iint=1,nint_gr(i)
11333 do j=istart(i,iint),iend(i,iint)
11335 if (itypj.eq.ntyp1) cycle
11339 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11340 fac_augm=rrij**expon
11341 e_augm=augm(itypi,itypj)*fac_augm
11342 r_inv_ij=dsqrt(rrij)
11344 sss=sscale(rij/sigma(itypi,itypj))
11345 if (sss.lt.1.0d0) then
11346 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
11347 fac=r_shift_inv**expon
11348 e1=fac*fac*aa(itypi,itypj)
11349 e2=fac*bb(itypi,itypj)
11350 evdwij=e_augm+e1+e2
11351 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11352 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11353 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
11354 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
11355 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
11356 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
11357 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
11358 evdw=evdw+(1.0d0-sss)*evdwij
11360 ! Calculate the components of the gradient in DC and X
11362 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
11363 fac=fac*(1.0d0-sss)
11368 gvdwx(k,i)=gvdwx(k,i)-gg(k)
11369 gvdwx(k,j)=gvdwx(k,j)+gg(k)
11370 gvdwc(k,i)=gvdwc(k,i)-gg(k)
11371 gvdwc(k,j)=gvdwc(k,j)+gg(k)
11379 gvdwc(j,i)=expon*gvdwc(j,i)
11380 gvdwx(j,i)=expon*gvdwx(j,i)
11384 end subroutine eljk_long
11385 !-----------------------------------------------------------------------------
11386 subroutine eljk_short(evdw)
11388 ! This subroutine calculates the interaction energy of nonbonded side chains
11389 ! assuming the LJK potential of interaction.
11391 ! implicit real*8 (a-h,o-z)
11392 ! include 'DIMENSIONS'
11393 ! include 'COMMON.GEO'
11394 ! include 'COMMON.VAR'
11395 ! include 'COMMON.LOCAL'
11396 ! include 'COMMON.CHAIN'
11397 ! include 'COMMON.DERIV'
11398 ! include 'COMMON.INTERACT'
11399 ! include 'COMMON.IOUNITS'
11400 ! include 'COMMON.NAMES'
11401 real(kind=8),dimension(3) :: gg
11403 !el local variables
11404 integer :: i,iint,j,k,itypi,itypi1,itypj
11405 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
11406 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
11407 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
11409 do i=iatsc_s,iatsc_e
11411 if (itypi.eq.ntyp1) cycle
11417 ! Calculate SC interaction energy.
11419 do iint=1,nint_gr(i)
11420 do j=istart(i,iint),iend(i,iint)
11422 if (itypj.eq.ntyp1) cycle
11426 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11427 fac_augm=rrij**expon
11428 e_augm=augm(itypi,itypj)*fac_augm
11429 r_inv_ij=dsqrt(rrij)
11431 sss=sscale(rij/sigma(itypi,itypj))
11432 if (sss.gt.0.0d0) then
11433 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
11434 fac=r_shift_inv**expon
11435 e1=fac*fac*aa(itypi,itypj)
11436 e2=fac*bb(itypi,itypj)
11437 evdwij=e_augm+e1+e2
11438 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11439 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11440 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
11441 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
11442 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
11443 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
11444 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
11445 evdw=evdw+sss*evdwij
11447 ! Calculate the components of the gradient in DC and X
11449 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
11455 gvdwx(k,i)=gvdwx(k,i)-gg(k)
11456 gvdwx(k,j)=gvdwx(k,j)+gg(k)
11457 gvdwc(k,i)=gvdwc(k,i)-gg(k)
11458 gvdwc(k,j)=gvdwc(k,j)+gg(k)
11466 gvdwc(j,i)=expon*gvdwc(j,i)
11467 gvdwx(j,i)=expon*gvdwx(j,i)
11471 end subroutine eljk_short
11472 !-----------------------------------------------------------------------------
11473 subroutine ebp_long(evdw)
11475 ! This subroutine calculates the interaction energy of nonbonded side chains
11476 ! assuming the Berne-Pechukas potential of interaction.
11479 ! implicit real*8 (a-h,o-z)
11480 ! include 'DIMENSIONS'
11481 ! include 'COMMON.GEO'
11482 ! include 'COMMON.VAR'
11483 ! include 'COMMON.LOCAL'
11484 ! include 'COMMON.CHAIN'
11485 ! include 'COMMON.DERIV'
11486 ! include 'COMMON.NAMES'
11487 ! include 'COMMON.INTERACT'
11488 ! include 'COMMON.IOUNITS'
11489 ! include 'COMMON.CALC'
11491 !el integer :: icall
11492 !el common /srutu/ icall
11493 ! double precision rrsave(maxdim)
11495 !el local variables
11496 integer :: iint,itypi,itypi1,itypj
11497 real(kind=8) :: rrij,xi,yi,zi,fac
11498 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
11500 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
11502 ! if (icall.eq.0) then
11508 do i=iatsc_s,iatsc_e
11510 if (itypi.eq.ntyp1) cycle
11515 dxi=dc_norm(1,nres+i)
11516 dyi=dc_norm(2,nres+i)
11517 dzi=dc_norm(3,nres+i)
11518 ! dsci_inv=dsc_inv(itypi)
11519 dsci_inv=vbld_inv(i+nres)
11521 ! Calculate SC interaction energy.
11523 do iint=1,nint_gr(i)
11524 do j=istart(i,iint),iend(i,iint)
11527 if (itypj.eq.ntyp1) cycle
11528 ! dscj_inv=dsc_inv(itypj)
11529 dscj_inv=vbld_inv(j+nres)
11530 chi1=chi(itypi,itypj)
11531 chi2=chi(itypj,itypi)
11538 alf12=0.5D0*(alf1+alf2)
11542 dxj=dc_norm(1,nres+j)
11543 dyj=dc_norm(2,nres+j)
11544 dzj=dc_norm(3,nres+j)
11545 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11547 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11549 if (sss.lt.1.0d0) then
11551 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
11553 ! Calculate whole angle-dependent part of epsilon and contributions
11554 ! to its derivatives
11555 fac=(rrij*sigsq)**expon2
11556 e1=fac*fac*aa(itypi,itypj)
11557 e2=fac*bb(itypi,itypj)
11558 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11559 eps2der=evdwij*eps3rt
11560 eps3der=evdwij*eps2rt
11561 evdwij=evdwij*eps2rt*eps3rt
11562 evdw=evdw+evdwij*(1.0d0-sss)
11564 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11565 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11566 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
11567 !d & restyp(itypi),i,restyp(itypj),j,
11568 !d & epsi,sigm,chi1,chi2,chip1,chip2,
11569 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
11570 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
11573 ! Calculate gradient components.
11574 e1=e1*eps1*eps2rt**2*eps3rt**2
11575 fac=-expon*(e1+evdwij)
11578 ! Calculate radial part of the gradient
11582 ! Calculate the angular part of the gradient and sum add the contributions
11583 ! to the appropriate components of the Cartesian gradient.
11584 call sc_grad_scale(1.0d0-sss)
11591 end subroutine ebp_long
11592 !-----------------------------------------------------------------------------
11593 subroutine ebp_short(evdw)
11595 ! This subroutine calculates the interaction energy of nonbonded side chains
11596 ! assuming the Berne-Pechukas potential of interaction.
11599 ! implicit real*8 (a-h,o-z)
11600 ! include 'DIMENSIONS'
11601 ! include 'COMMON.GEO'
11602 ! include 'COMMON.VAR'
11603 ! include 'COMMON.LOCAL'
11604 ! include 'COMMON.CHAIN'
11605 ! include 'COMMON.DERIV'
11606 ! include 'COMMON.NAMES'
11607 ! include 'COMMON.INTERACT'
11608 ! include 'COMMON.IOUNITS'
11609 ! include 'COMMON.CALC'
11611 !el integer :: icall
11612 !el common /srutu/ icall
11613 ! double precision rrsave(maxdim)
11615 !el local variables
11616 integer :: iint,itypi,itypi1,itypj
11617 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
11618 real(kind=8) :: sss,e1,e2,evdw
11620 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
11622 ! if (icall.eq.0) then
11628 do i=iatsc_s,iatsc_e
11630 if (itypi.eq.ntyp1) cycle
11635 dxi=dc_norm(1,nres+i)
11636 dyi=dc_norm(2,nres+i)
11637 dzi=dc_norm(3,nres+i)
11638 ! dsci_inv=dsc_inv(itypi)
11639 dsci_inv=vbld_inv(i+nres)
11641 ! Calculate SC interaction energy.
11643 do iint=1,nint_gr(i)
11644 do j=istart(i,iint),iend(i,iint)
11647 if (itypj.eq.ntyp1) cycle
11648 ! dscj_inv=dsc_inv(itypj)
11649 dscj_inv=vbld_inv(j+nres)
11650 chi1=chi(itypi,itypj)
11651 chi2=chi(itypj,itypi)
11658 alf12=0.5D0*(alf1+alf2)
11662 dxj=dc_norm(1,nres+j)
11663 dyj=dc_norm(2,nres+j)
11664 dzj=dc_norm(3,nres+j)
11665 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11667 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11669 if (sss.gt.0.0d0) then
11671 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
11673 ! Calculate whole angle-dependent part of epsilon and contributions
11674 ! to its derivatives
11675 fac=(rrij*sigsq)**expon2
11676 e1=fac*fac*aa(itypi,itypj)
11677 e2=fac*bb(itypi,itypj)
11678 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11679 eps2der=evdwij*eps3rt
11680 eps3der=evdwij*eps2rt
11681 evdwij=evdwij*eps2rt*eps3rt
11682 evdw=evdw+evdwij*sss
11684 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11685 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11686 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
11687 !d & restyp(itypi),i,restyp(itypj),j,
11688 !d & epsi,sigm,chi1,chi2,chip1,chip2,
11689 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
11690 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
11693 ! Calculate gradient components.
11694 e1=e1*eps1*eps2rt**2*eps3rt**2
11695 fac=-expon*(e1+evdwij)
11698 ! Calculate radial part of the gradient
11702 ! Calculate the angular part of the gradient and sum add the contributions
11703 ! to the appropriate components of the Cartesian gradient.
11704 call sc_grad_scale(sss)
11711 end subroutine ebp_short
11712 !-----------------------------------------------------------------------------
11713 subroutine egb_long(evdw)
11715 ! This subroutine calculates the interaction energy of nonbonded side chains
11716 ! assuming the Gay-Berne potential of interaction.
11719 ! implicit real*8 (a-h,o-z)
11720 ! include 'DIMENSIONS'
11721 ! include 'COMMON.GEO'
11722 ! include 'COMMON.VAR'
11723 ! include 'COMMON.LOCAL'
11724 ! include 'COMMON.CHAIN'
11725 ! include 'COMMON.DERIV'
11726 ! include 'COMMON.NAMES'
11727 ! include 'COMMON.INTERACT'
11728 ! include 'COMMON.IOUNITS'
11729 ! include 'COMMON.CALC'
11730 ! include 'COMMON.CONTROL'
11732 !el local variables
11733 integer :: iint,itypi,itypi1,itypj,subchap
11734 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
11735 real(kind=8) :: sss,e1,e2,evdw,sss_grad
11736 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
11737 dist_temp, dist_init
11740 !cccc energy_dec=.false.
11741 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11744 ! if (icall.eq.0) lprn=.false.
11746 do i=iatsc_s,iatsc_e
11748 if (itypi.eq.ntyp1) cycle
11753 xi=mod(xi,boxxsize)
11754 if (xi.lt.0) xi=xi+boxxsize
11755 yi=mod(yi,boxysize)
11756 if (yi.lt.0) yi=yi+boxysize
11757 zi=mod(zi,boxzsize)
11758 if (zi.lt.0) zi=zi+boxzsize
11759 dxi=dc_norm(1,nres+i)
11760 dyi=dc_norm(2,nres+i)
11761 dzi=dc_norm(3,nres+i)
11762 ! dsci_inv=dsc_inv(itypi)
11763 dsci_inv=vbld_inv(i+nres)
11764 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
11765 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
11767 ! Calculate SC interaction energy.
11769 do iint=1,nint_gr(i)
11770 do j=istart(i,iint),iend(i,iint)
11773 if (itypj.eq.ntyp1) cycle
11774 ! dscj_inv=dsc_inv(itypj)
11775 dscj_inv=vbld_inv(j+nres)
11776 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
11777 ! & 1.0d0/vbld(j+nres)
11778 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
11779 sig0ij=sigma(itypi,itypj)
11780 chi1=chi(itypi,itypj)
11781 chi2=chi(itypj,itypi)
11788 alf12=0.5D0*(alf1+alf2)
11792 ! Searching for nearest neighbour
11793 xj=mod(xj,boxxsize)
11794 if (xj.lt.0) xj=xj+boxxsize
11795 yj=mod(yj,boxysize)
11796 if (yj.lt.0) yj=yj+boxysize
11797 zj=mod(zj,boxzsize)
11798 if (zj.lt.0) zj=zj+boxzsize
11799 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
11807 xj=xj_safe+xshift*boxxsize
11808 yj=yj_safe+yshift*boxysize
11809 zj=zj_safe+zshift*boxzsize
11810 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
11811 if(dist_temp.lt.dist_init) then
11812 dist_init=dist_temp
11821 if (subchap.eq.1) then
11831 dxj=dc_norm(1,nres+j)
11832 dyj=dc_norm(2,nres+j)
11833 dzj=dc_norm(3,nres+j)
11834 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11836 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11837 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
11838 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
11839 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
11840 if (sss_ele_cut.le.0.0) cycle
11841 if (sss.lt.1.0d0) then
11843 ! Calculate angle-dependent terms of energy and contributions to their
11847 sig=sig0ij*dsqrt(sigsq)
11848 rij_shift=1.0D0/rij-sig+sig0ij
11849 ! for diagnostics; uncomment
11850 ! rij_shift=1.2*sig0ij
11851 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11852 if (rij_shift.le.0.0D0) then
11854 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
11855 !d & restyp(itypi),i,restyp(itypj),j,
11856 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
11860 !---------------------------------------------------------------
11861 rij_shift=1.0D0/rij_shift
11862 fac=rij_shift**expon
11863 e1=fac*fac*aa(itypi,itypj)
11864 e2=fac*bb(itypi,itypj)
11865 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11866 eps2der=evdwij*eps3rt
11867 eps3der=evdwij*eps2rt
11868 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
11869 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
11870 evdwij=evdwij*eps2rt*eps3rt
11871 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
11873 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11874 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11875 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11876 restyp(itypi),i,restyp(itypj),j,&
11877 epsi,sigm,chi1,chi2,chip1,chip2,&
11878 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
11879 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
11883 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
11885 ! if (energy_dec) write (iout,*) &
11886 ! 'evdw',i,j,evdwij,"egb_long"
11888 ! Calculate gradient components.
11889 e1=e1*eps1*eps2rt**2*eps3rt**2
11890 fac=-expon*(e1+evdwij)*rij_shift
11893 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
11894 /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
11895 /sigmaii(itypi,itypj))
11897 ! Calculate the radial part of the gradient
11901 ! Calculate angular part of the gradient.
11902 call sc_grad_scale(1.0d0-sss)
11907 ! write (iout,*) "Number of loop steps in EGB:",ind
11908 !ccc energy_dec=.false.
11910 end subroutine egb_long
11911 !-----------------------------------------------------------------------------
11912 subroutine egb_short(evdw)
11914 ! This subroutine calculates the interaction energy of nonbonded side chains
11915 ! assuming the Gay-Berne potential of interaction.
11918 ! implicit real*8 (a-h,o-z)
11919 ! include 'DIMENSIONS'
11920 ! include 'COMMON.GEO'
11921 ! include 'COMMON.VAR'
11922 ! include 'COMMON.LOCAL'
11923 ! include 'COMMON.CHAIN'
11924 ! include 'COMMON.DERIV'
11925 ! include 'COMMON.NAMES'
11926 ! include 'COMMON.INTERACT'
11927 ! include 'COMMON.IOUNITS'
11928 ! include 'COMMON.CALC'
11929 ! include 'COMMON.CONTROL'
11931 !el local variables
11932 integer :: iint,itypi,itypi1,itypj,subchap
11933 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
11934 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
11935 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
11936 dist_temp, dist_init
11938 !cccc energy_dec=.false.
11939 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11942 ! if (icall.eq.0) lprn=.false.
11944 do i=iatsc_s,iatsc_e
11946 if (itypi.eq.ntyp1) cycle
11951 xi=mod(xi,boxxsize)
11952 if (xi.lt.0) xi=xi+boxxsize
11953 yi=mod(yi,boxysize)
11954 if (yi.lt.0) yi=yi+boxysize
11955 zi=mod(zi,boxzsize)
11956 if (zi.lt.0) zi=zi+boxzsize
11957 dxi=dc_norm(1,nres+i)
11958 dyi=dc_norm(2,nres+i)
11959 dzi=dc_norm(3,nres+i)
11960 ! dsci_inv=dsc_inv(itypi)
11961 dsci_inv=vbld_inv(i+nres)
11963 dxi=dc_norm(1,nres+i)
11964 dyi=dc_norm(2,nres+i)
11965 dzi=dc_norm(3,nres+i)
11966 ! dsci_inv=dsc_inv(itypi)
11967 dsci_inv=vbld_inv(i+nres)
11968 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
11969 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
11971 ! Calculate SC interaction energy.
11973 do iint=1,nint_gr(i)
11974 do j=istart(i,iint),iend(i,iint)
11977 if (itypj.eq.ntyp1) cycle
11978 ! dscj_inv=dsc_inv(itypj)
11979 dscj_inv=vbld_inv(j+nres)
11980 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
11981 ! & 1.0d0/vbld(j+nres)
11982 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
11983 sig0ij=sigma(itypi,itypj)
11984 chi1=chi(itypi,itypj)
11985 chi2=chi(itypj,itypi)
11992 alf12=0.5D0*(alf1+alf2)
11993 ! xj=c(1,nres+j)-xi
11994 ! yj=c(2,nres+j)-yi
11995 ! zj=c(3,nres+j)-zi
11999 ! Searching for nearest neighbour
12000 xj=mod(xj,boxxsize)
12001 if (xj.lt.0) xj=xj+boxxsize
12002 yj=mod(yj,boxysize)
12003 if (yj.lt.0) yj=yj+boxysize
12004 zj=mod(zj,boxzsize)
12005 if (zj.lt.0) zj=zj+boxzsize
12006 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
12014 xj=xj_safe+xshift*boxxsize
12015 yj=yj_safe+yshift*boxysize
12016 zj=zj_safe+zshift*boxzsize
12017 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
12018 if(dist_temp.lt.dist_init) then
12019 dist_init=dist_temp
12028 if (subchap.eq.1) then
12038 dxj=dc_norm(1,nres+j)
12039 dyj=dc_norm(2,nres+j)
12040 dzj=dc_norm(3,nres+j)
12041 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12043 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12044 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
12045 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
12046 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
12047 if (sss_ele_cut.le.0.0) cycle
12049 if (sss.gt.0.0d0) then
12051 ! Calculate angle-dependent terms of energy and contributions to their
12055 sig=sig0ij*dsqrt(sigsq)
12056 rij_shift=1.0D0/rij-sig+sig0ij
12057 ! for diagnostics; uncomment
12058 ! rij_shift=1.2*sig0ij
12059 ! I hate to put IF's in the loops, but here don't have another choice!!!!
12060 if (rij_shift.le.0.0D0) then
12062 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
12063 !d & restyp(itypi),i,restyp(itypj),j,
12064 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
12068 !---------------------------------------------------------------
12069 rij_shift=1.0D0/rij_shift
12070 fac=rij_shift**expon
12071 e1=fac*fac*aa(itypi,itypj)
12072 e2=fac*bb(itypi,itypj)
12073 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12074 eps2der=evdwij*eps3rt
12075 eps3der=evdwij*eps2rt
12076 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
12077 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
12078 evdwij=evdwij*eps2rt*eps3rt
12079 evdw=evdw+evdwij*sss*sss_ele_cut
12081 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12082 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12083 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
12084 restyp(itypi),i,restyp(itypj),j,&
12085 epsi,sigm,chi1,chi2,chip1,chip2,&
12086 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
12087 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
12091 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
12093 ! if (energy_dec) write (iout,*) &
12094 ! 'evdw',i,j,evdwij,"egb_short"
12096 ! Calculate gradient components.
12097 e1=e1*eps1*eps2rt**2*eps3rt**2
12098 fac=-expon*(e1+evdwij)*rij_shift
12101 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
12102 /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
12103 /sigmaii(itypi,itypj))
12106 ! Calculate the radial part of the gradient
12110 ! Calculate angular part of the gradient.
12111 call sc_grad_scale(sss)
12116 ! write (iout,*) "Number of loop steps in EGB:",ind
12117 !ccc energy_dec=.false.
12119 end subroutine egb_short
12120 !-----------------------------------------------------------------------------
12121 subroutine egbv_long(evdw)
12123 ! This subroutine calculates the interaction energy of nonbonded side chains
12124 ! assuming the Gay-Berne-Vorobjev potential of interaction.
12127 ! implicit real*8 (a-h,o-z)
12128 ! include 'DIMENSIONS'
12129 ! include 'COMMON.GEO'
12130 ! include 'COMMON.VAR'
12131 ! include 'COMMON.LOCAL'
12132 ! include 'COMMON.CHAIN'
12133 ! include 'COMMON.DERIV'
12134 ! include 'COMMON.NAMES'
12135 ! include 'COMMON.INTERACT'
12136 ! include 'COMMON.IOUNITS'
12137 ! include 'COMMON.CALC'
12139 !el integer :: icall
12140 !el common /srutu/ icall
12142 !el local variables
12143 integer :: iint,itypi,itypi1,itypj
12144 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
12145 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
12147 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
12150 ! if (icall.eq.0) lprn=.true.
12152 do i=iatsc_s,iatsc_e
12154 if (itypi.eq.ntyp1) cycle
12159 dxi=dc_norm(1,nres+i)
12160 dyi=dc_norm(2,nres+i)
12161 dzi=dc_norm(3,nres+i)
12162 ! dsci_inv=dsc_inv(itypi)
12163 dsci_inv=vbld_inv(i+nres)
12165 ! Calculate SC interaction energy.
12167 do iint=1,nint_gr(i)
12168 do j=istart(i,iint),iend(i,iint)
12171 if (itypj.eq.ntyp1) cycle
12172 ! dscj_inv=dsc_inv(itypj)
12173 dscj_inv=vbld_inv(j+nres)
12174 sig0ij=sigma(itypi,itypj)
12175 r0ij=r0(itypi,itypj)
12176 chi1=chi(itypi,itypj)
12177 chi2=chi(itypj,itypi)
12184 alf12=0.5D0*(alf1+alf2)
12188 dxj=dc_norm(1,nres+j)
12189 dyj=dc_norm(2,nres+j)
12190 dzj=dc_norm(3,nres+j)
12191 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12194 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12196 if (sss.lt.1.0d0) then
12198 ! Calculate angle-dependent terms of energy and contributions to their
12202 sig=sig0ij*dsqrt(sigsq)
12203 rij_shift=1.0D0/rij-sig+r0ij
12204 ! I hate to put IF's in the loops, but here don't have another choice!!!!
12205 if (rij_shift.le.0.0D0) then
12210 !---------------------------------------------------------------
12211 rij_shift=1.0D0/rij_shift
12212 fac=rij_shift**expon
12213 e1=fac*fac*aa(itypi,itypj)
12214 e2=fac*bb(itypi,itypj)
12215 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12216 eps2der=evdwij*eps3rt
12217 eps3der=evdwij*eps2rt
12218 fac_augm=rrij**expon
12219 e_augm=augm(itypi,itypj)*fac_augm
12220 evdwij=evdwij*eps2rt*eps3rt
12221 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
12223 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12224 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12225 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
12226 restyp(itypi),i,restyp(itypj),j,&
12227 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
12228 chi1,chi2,chip1,chip2,&
12229 eps1,eps2rt**2,eps3rt**2,&
12230 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
12233 ! Calculate gradient components.
12234 e1=e1*eps1*eps2rt**2*eps3rt**2
12235 fac=-expon*(e1+evdwij)*rij_shift
12237 fac=rij*fac-2*expon*rrij*e_augm
12238 ! Calculate the radial part of the gradient
12242 ! Calculate angular part of the gradient.
12243 call sc_grad_scale(1.0d0-sss)
12248 end subroutine egbv_long
12249 !-----------------------------------------------------------------------------
12250 subroutine egbv_short(evdw)
12252 ! This subroutine calculates the interaction energy of nonbonded side chains
12253 ! assuming the Gay-Berne-Vorobjev potential of interaction.
12256 ! implicit real*8 (a-h,o-z)
12257 ! include 'DIMENSIONS'
12258 ! include 'COMMON.GEO'
12259 ! include 'COMMON.VAR'
12260 ! include 'COMMON.LOCAL'
12261 ! include 'COMMON.CHAIN'
12262 ! include 'COMMON.DERIV'
12263 ! include 'COMMON.NAMES'
12264 ! include 'COMMON.INTERACT'
12265 ! include 'COMMON.IOUNITS'
12266 ! include 'COMMON.CALC'
12268 !el integer :: icall
12269 !el common /srutu/ icall
12271 !el local variables
12272 integer :: iint,itypi,itypi1,itypj
12273 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
12274 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
12276 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
12279 ! if (icall.eq.0) lprn=.true.
12281 do i=iatsc_s,iatsc_e
12283 if (itypi.eq.ntyp1) cycle
12288 dxi=dc_norm(1,nres+i)
12289 dyi=dc_norm(2,nres+i)
12290 dzi=dc_norm(3,nres+i)
12291 ! dsci_inv=dsc_inv(itypi)
12292 dsci_inv=vbld_inv(i+nres)
12294 ! Calculate SC interaction energy.
12296 do iint=1,nint_gr(i)
12297 do j=istart(i,iint),iend(i,iint)
12300 if (itypj.eq.ntyp1) cycle
12301 ! dscj_inv=dsc_inv(itypj)
12302 dscj_inv=vbld_inv(j+nres)
12303 sig0ij=sigma(itypi,itypj)
12304 r0ij=r0(itypi,itypj)
12305 chi1=chi(itypi,itypj)
12306 chi2=chi(itypj,itypi)
12313 alf12=0.5D0*(alf1+alf2)
12317 dxj=dc_norm(1,nres+j)
12318 dyj=dc_norm(2,nres+j)
12319 dzj=dc_norm(3,nres+j)
12320 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12323 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12325 if (sss.gt.0.0d0) then
12327 ! Calculate angle-dependent terms of energy and contributions to their
12331 sig=sig0ij*dsqrt(sigsq)
12332 rij_shift=1.0D0/rij-sig+r0ij
12333 ! I hate to put IF's in the loops, but here don't have another choice!!!!
12334 if (rij_shift.le.0.0D0) then
12339 !---------------------------------------------------------------
12340 rij_shift=1.0D0/rij_shift
12341 fac=rij_shift**expon
12342 e1=fac*fac*aa(itypi,itypj)
12343 e2=fac*bb(itypi,itypj)
12344 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12345 eps2der=evdwij*eps3rt
12346 eps3der=evdwij*eps2rt
12347 fac_augm=rrij**expon
12348 e_augm=augm(itypi,itypj)*fac_augm
12349 evdwij=evdwij*eps2rt*eps3rt
12350 evdw=evdw+(evdwij+e_augm)*sss
12352 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12353 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12354 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
12355 restyp(itypi),i,restyp(itypj),j,&
12356 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
12357 chi1,chi2,chip1,chip2,&
12358 eps1,eps2rt**2,eps3rt**2,&
12359 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
12362 ! Calculate gradient components.
12363 e1=e1*eps1*eps2rt**2*eps3rt**2
12364 fac=-expon*(e1+evdwij)*rij_shift
12366 fac=rij*fac-2*expon*rrij*e_augm
12367 ! Calculate the radial part of the gradient
12371 ! Calculate angular part of the gradient.
12372 call sc_grad_scale(sss)
12377 end subroutine egbv_short
12378 !-----------------------------------------------------------------------------
12379 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
12381 ! This subroutine calculates the average interaction energy and its gradient
12382 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
12383 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
12384 ! The potential depends both on the distance of peptide-group centers and on
12385 ! the orientation of the CA-CA virtual bonds.
12387 ! implicit real*8 (a-h,o-z)
12393 ! include 'DIMENSIONS'
12394 ! include 'COMMON.CONTROL'
12395 ! include 'COMMON.SETUP'
12396 ! include 'COMMON.IOUNITS'
12397 ! include 'COMMON.GEO'
12398 ! include 'COMMON.VAR'
12399 ! include 'COMMON.LOCAL'
12400 ! include 'COMMON.CHAIN'
12401 ! include 'COMMON.DERIV'
12402 ! include 'COMMON.INTERACT'
12403 ! include 'COMMON.CONTACTS'
12404 ! include 'COMMON.TORSION'
12405 ! include 'COMMON.VECTORS'
12406 ! include 'COMMON.FFIELD'
12407 ! include 'COMMON.TIME1'
12408 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
12409 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
12410 real(kind=8),dimension(2,2) :: acipa !el,a_temp
12411 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
12412 real(kind=8),dimension(4) :: muij
12413 !el integer :: num_conti,j1,j2
12414 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
12415 !el dz_normi,xmedi,ymedi,zmedi
12416 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
12417 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
12418 !el num_conti,j1,j2
12419 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
12421 real(kind=8) :: scal_el=1.0d0
12423 real(kind=8) :: scal_el=0.5d0
12426 ! 13-go grudnia roku pamietnego...
12427 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
12428 0.0d0,1.0d0,0.0d0,&
12429 0.0d0,0.0d0,1.0d0/),shape(unmat))
12430 !el local variables
12432 real(kind=8) :: fac
12433 real(kind=8) :: dxj,dyj,dzj
12434 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
12436 ! allocate(num_cont_hb(nres)) !(maxres)
12437 !d write(iout,*) 'In EELEC'
12439 !d write(iout,*) 'Type',i
12440 !d write(iout,*) 'B1',B1(:,i)
12441 !d write(iout,*) 'B2',B2(:,i)
12442 !d write(iout,*) 'CC',CC(:,:,i)
12443 !d write(iout,*) 'DD',DD(:,:,i)
12444 !d write(iout,*) 'EE',EE(:,:,i)
12446 !d call check_vecgrad
12448 if (icheckgrad.eq.1) then
12450 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
12452 dc_norm(k,i)=dc(k,i)*fac
12454 ! write (iout,*) 'i',i,' fac',fac
12457 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
12458 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
12459 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
12460 ! call vec_and_deriv
12466 time_mat=time_mat+MPI_Wtime()-time01
12470 !d write (iout,*) 'i=',i
12472 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
12475 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
12476 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
12489 !d print '(a)','Enter EELEC'
12490 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
12491 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
12492 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
12494 gel_loc_loc(i)=0.0d0
12499 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
12501 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
12503 do i=iturn3_start,iturn3_end
12504 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1 &
12505 .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
12509 dx_normi=dc_norm(1,i)
12510 dy_normi=dc_norm(2,i)
12511 dz_normi=dc_norm(3,i)
12512 xmedi=c(1,i)+0.5d0*dxi
12513 ymedi=c(2,i)+0.5d0*dyi
12514 zmedi=c(3,i)+0.5d0*dzi
12516 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
12517 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
12518 num_cont_hb(i)=num_conti
12520 do i=iturn4_start,iturn4_end
12521 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
12522 .or. itype(i+3).eq.ntyp1 &
12523 .or. itype(i+4).eq.ntyp1) cycle
12527 dx_normi=dc_norm(1,i)
12528 dy_normi=dc_norm(2,i)
12529 dz_normi=dc_norm(3,i)
12530 xmedi=c(1,i)+0.5d0*dxi
12531 ymedi=c(2,i)+0.5d0*dyi
12532 zmedi=c(3,i)+0.5d0*dzi
12533 num_conti=num_cont_hb(i)
12534 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
12535 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
12536 call eturn4(i,eello_turn4)
12537 num_cont_hb(i)=num_conti
12540 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
12542 do i=iatel_s,iatel_e
12543 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
12547 dx_normi=dc_norm(1,i)
12548 dy_normi=dc_norm(2,i)
12549 dz_normi=dc_norm(3,i)
12550 xmedi=c(1,i)+0.5d0*dxi
12551 ymedi=c(2,i)+0.5d0*dyi
12552 zmedi=c(3,i)+0.5d0*dzi
12553 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
12554 num_conti=num_cont_hb(i)
12555 do j=ielstart(i),ielend(i)
12556 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
12557 call eelecij_scale(i,j,ees,evdw1,eel_loc)
12559 num_cont_hb(i)=num_conti
12561 ! write (iout,*) "Number of loop steps in EELEC:",ind
12563 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
12564 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
12566 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
12567 !cc eel_loc=eel_loc+eello_turn3
12568 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
12570 end subroutine eelec_scale
12571 !-----------------------------------------------------------------------------
12572 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
12573 ! implicit real*8 (a-h,o-z)
12576 ! include 'DIMENSIONS'
12580 ! include 'COMMON.CONTROL'
12581 ! include 'COMMON.IOUNITS'
12582 ! include 'COMMON.GEO'
12583 ! include 'COMMON.VAR'
12584 ! include 'COMMON.LOCAL'
12585 ! include 'COMMON.CHAIN'
12586 ! include 'COMMON.DERIV'
12587 ! include 'COMMON.INTERACT'
12588 ! include 'COMMON.CONTACTS'
12589 ! include 'COMMON.TORSION'
12590 ! include 'COMMON.VECTORS'
12591 ! include 'COMMON.FFIELD'
12592 ! include 'COMMON.TIME1'
12593 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
12594 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
12595 real(kind=8),dimension(2,2) :: acipa !el,a_temp
12596 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
12597 real(kind=8),dimension(4) :: muij
12598 !el integer :: num_conti,j1,j2
12599 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
12600 !el dz_normi,xmedi,ymedi,zmedi
12601 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
12602 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
12603 !el num_conti,j1,j2
12604 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
12606 real(kind=8) :: scal_el=1.0d0
12608 real(kind=8) :: scal_el=0.5d0
12611 ! 13-go grudnia roku pamietnego...
12612 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
12613 0.0d0,1.0d0,0.0d0,&
12614 0.0d0,0.0d0,1.0d0/),shape(unmat))
12615 !el local variables
12616 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m
12617 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
12618 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
12619 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
12620 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
12621 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
12622 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
12623 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
12624 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
12625 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
12626 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
12627 ecosam,ecosbm,ecosgm,ghalf,time00
12628 ! integer :: maxconts
12629 ! maxconts = nres/4
12630 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12631 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12632 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12633 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12634 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12635 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12636 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12637 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12638 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
12639 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
12640 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
12641 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
12642 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
12644 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
12645 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
12650 !d write (iout,*) "eelecij",i,j
12654 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
12655 aaa=app(iteli,itelj)
12656 bbb=bpp(iteli,itelj)
12657 ael6i=ael6(iteli,itelj)
12658 ael3i=ael3(iteli,itelj)
12662 dx_normj=dc_norm(1,j)
12663 dy_normj=dc_norm(2,j)
12664 dz_normj=dc_norm(3,j)
12665 xj=c(1,j)+0.5D0*dxj-xmedi
12666 yj=c(2,j)+0.5D0*dyj-ymedi
12667 zj=c(3,j)+0.5D0*dzj-zmedi
12668 rij=xj*xj+yj*yj+zj*zj
12672 ! For extracting the short-range part of Evdwpp
12673 sss=sscale(rij/rpp(iteli,itelj))
12677 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
12678 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
12679 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
12680 fac=cosa-3.0D0*cosb*cosg
12682 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
12683 if (j.eq.i+2) ev1=scal_el*ev1
12688 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
12691 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
12692 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
12694 evdw1=evdw1+evdwij*(1.0d0-sss)
12695 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
12696 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
12697 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
12698 !d & xmedi,ymedi,zmedi,xj,yj,zj
12700 if (energy_dec) then
12701 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
12702 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
12706 ! Calculate contributions to the Cartesian gradient.
12709 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)
12710 facel=-3*rrmij*(el1+eesij)
12716 ! Radial derivatives. First process both termini of the fragment (i,j)
12722 ! ghalf=0.5D0*ggg(k)
12723 ! gelc(k,i)=gelc(k,i)+ghalf
12724 ! gelc(k,j)=gelc(k,j)+ghalf
12726 ! 9/28/08 AL Gradient compotents will be summed only at the end
12728 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
12729 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
12732 ! Loop over residues i+1 thru j-1.
12736 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12743 ! ghalf=0.5D0*ggg(k)
12744 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
12745 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
12747 ! 9/28/08 AL Gradient compotents will be summed only at the end
12749 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12750 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12753 ! Loop over residues i+1 thru j-1.
12757 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
12761 facvdw=ev1+evdwij*(1.0d0-sss)
12764 fac=-3*rrmij*(facvdw+facvdw+facel)
12769 ! Radial derivatives. First process both termini of the fragment (i,j)
12775 ! ghalf=0.5D0*ggg(k)
12776 ! gelc(k,i)=gelc(k,i)+ghalf
12777 ! gelc(k,j)=gelc(k,j)+ghalf
12779 ! 9/28/08 AL Gradient compotents will be summed only at the end
12781 gelc_long(k,j)=gelc(k,j)+ggg(k)
12782 gelc_long(k,i)=gelc(k,i)-ggg(k)
12785 ! Loop over residues i+1 thru j-1.
12789 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12792 ! 9/28/08 AL Gradient compotents will be summed only at the end
12797 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12798 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12804 ecosa=2.0D0*fac3*fac1+fac4
12807 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
12808 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
12810 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
12811 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
12813 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
12814 !d & (dcosg(k),k=1,3)
12816 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
12819 ! ghalf=0.5D0*ggg(k)
12820 ! gelc(k,i)=gelc(k,i)+ghalf
12821 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
12822 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12823 ! gelc(k,j)=gelc(k,j)+ghalf
12824 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
12825 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12829 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12833 gelc(k,i)=gelc(k,i) &
12834 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
12835 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12836 gelc(k,j)=gelc(k,j) &
12837 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
12838 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12839 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
12840 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
12842 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
12843 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
12844 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
12846 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
12847 ! energy of a peptide unit is assumed in the form of a second-order
12848 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
12849 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
12850 ! are computed for EVERY pair of non-contiguous peptide groups.
12852 if (j.lt.nres-1) then
12863 muij(kkk)=mu(k,i)*mu(l,j)
12866 !d write (iout,*) 'EELEC: i',i,' j',j
12867 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
12868 !d write(iout,*) 'muij',muij
12869 ury=scalar(uy(1,i),erij)
12870 urz=scalar(uz(1,i),erij)
12871 vry=scalar(uy(1,j),erij)
12872 vrz=scalar(uz(1,j),erij)
12873 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
12874 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
12875 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
12876 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
12877 fac=dsqrt(-ael6i)*r3ij
12882 !d write (iout,'(4i5,4f10.5)')
12883 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
12884 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
12885 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
12886 !d & uy(:,j),uz(:,j)
12887 !d write (iout,'(4f10.5)')
12888 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
12889 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
12890 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
12891 !d write (iout,'(9f10.5/)')
12892 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
12893 ! Derivatives of the elements of A in virtual-bond vectors
12894 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
12896 uryg(k,1)=scalar(erder(1,k),uy(1,i))
12897 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
12898 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
12899 urzg(k,1)=scalar(erder(1,k),uz(1,i))
12900 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
12901 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
12902 vryg(k,1)=scalar(erder(1,k),uy(1,j))
12903 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
12904 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
12905 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
12906 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
12907 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
12909 ! Compute radial contributions to the gradient
12927 ! Add the contributions coming from er
12930 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
12931 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
12932 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
12933 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
12936 ! Derivatives in DC(i)
12937 !grad ghalf1=0.5d0*agg(k,1)
12938 !grad ghalf2=0.5d0*agg(k,2)
12939 !grad ghalf3=0.5d0*agg(k,3)
12940 !grad ghalf4=0.5d0*agg(k,4)
12941 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
12942 -3.0d0*uryg(k,2)*vry)!+ghalf1
12943 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
12944 -3.0d0*uryg(k,2)*vrz)!+ghalf2
12945 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
12946 -3.0d0*urzg(k,2)*vry)!+ghalf3
12947 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
12948 -3.0d0*urzg(k,2)*vrz)!+ghalf4
12949 ! Derivatives in DC(i+1)
12950 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
12951 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
12952 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
12953 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
12954 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
12955 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
12956 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
12957 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
12958 ! Derivatives in DC(j)
12959 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
12960 -3.0d0*vryg(k,2)*ury)!+ghalf1
12961 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
12962 -3.0d0*vrzg(k,2)*ury)!+ghalf2
12963 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
12964 -3.0d0*vryg(k,2)*urz)!+ghalf3
12965 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
12966 -3.0d0*vrzg(k,2)*urz)!+ghalf4
12967 ! Derivatives in DC(j+1) or DC(nres-1)
12968 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
12969 -3.0d0*vryg(k,3)*ury)
12970 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
12971 -3.0d0*vrzg(k,3)*ury)
12972 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
12973 -3.0d0*vryg(k,3)*urz)
12974 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
12975 -3.0d0*vrzg(k,3)*urz)
12976 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
12978 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
12991 aggi(k,l)=-aggi(k,l)
12992 aggi1(k,l)=-aggi1(k,l)
12993 aggj(k,l)=-aggj(k,l)
12994 aggj1(k,l)=-aggj1(k,l)
12997 if (j.lt.nres-1) then
13003 aggi(k,l)=-aggi(k,l)
13004 aggi1(k,l)=-aggi1(k,l)
13005 aggj(k,l)=-aggj(k,l)
13006 aggj1(k,l)=-aggj1(k,l)
13017 aggi(k,l)=-aggi(k,l)
13018 aggi1(k,l)=-aggi1(k,l)
13019 aggj(k,l)=-aggj(k,l)
13020 aggj1(k,l)=-aggj1(k,l)
13025 IF (wel_loc.gt.0.0d0) THEN
13026 ! Contribution to the local-electrostatic energy coming from the i-j pair
13027 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
13029 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
13031 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13032 'eelloc',i,j,eel_loc_ij
13033 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
13035 eel_loc=eel_loc+eel_loc_ij
13036 ! Partial derivatives in virtual-bond dihedral angles gamma
13038 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
13039 a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
13040 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
13041 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
13042 a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
13043 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
13044 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
13046 ggg(l)=agg(l,1)*muij(1)+ &
13047 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
13048 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
13049 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
13050 !grad ghalf=0.5d0*ggg(l)
13051 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
13052 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
13056 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
13059 ! Remaining derivatives of eello
13061 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ &
13062 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
13063 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ &
13064 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
13065 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ &
13066 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
13067 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ &
13068 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
13071 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
13072 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
13073 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
13074 .and. num_conti.le.maxconts) then
13075 ! write (iout,*) i,j," entered corr"
13077 ! Calculate the contact function. The ith column of the array JCONT will
13078 ! contain the numbers of atoms that make contacts with the atom I (of numbers
13079 ! greater than I). The arrays FACONT and GACONT will contain the values of
13080 ! the contact function and its derivative.
13081 ! r0ij=1.02D0*rpp(iteli,itelj)
13082 ! r0ij=1.11D0*rpp(iteli,itelj)
13083 r0ij=2.20D0*rpp(iteli,itelj)
13084 ! r0ij=1.55D0*rpp(iteli,itelj)
13085 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
13086 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
13087 if (fcont.gt.0.0D0) then
13088 num_conti=num_conti+1
13089 if (num_conti.gt.maxconts) then
13090 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
13091 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
13092 ' will skip next contacts for this conf.',num_conti
13094 jcont_hb(num_conti,i)=j
13095 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
13096 !d & " jcont_hb",jcont_hb(num_conti,i)
13097 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
13098 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
13099 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
13101 d_cont(num_conti,i)=rij
13102 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
13103 ! --- Electrostatic-interaction matrix ---
13104 a_chuj(1,1,num_conti,i)=a22
13105 a_chuj(1,2,num_conti,i)=a23
13106 a_chuj(2,1,num_conti,i)=a32
13107 a_chuj(2,2,num_conti,i)=a33
13108 ! --- Gradient of rij
13110 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
13117 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
13118 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
13119 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
13120 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
13121 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
13126 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
13127 ! Calculate contact energies
13129 wij=cosa-3.0D0*cosb*cosg
13132 ! fac3=dsqrt(-ael6i)/r0ij**3
13133 fac3=dsqrt(-ael6i)*r3ij
13134 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
13135 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
13136 if (ees0tmp.gt.0) then
13137 ees0pij=dsqrt(ees0tmp)
13141 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
13142 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
13143 if (ees0tmp.gt.0) then
13144 ees0mij=dsqrt(ees0tmp)
13149 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
13150 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
13151 ! Diagnostics. Comment out or remove after debugging!
13152 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
13153 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
13154 ! ees0m(num_conti,i)=0.0D0
13156 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
13157 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
13158 ! Angular derivatives of the contact function
13159 ees0pij1=fac3/ees0pij
13160 ees0mij1=fac3/ees0mij
13161 fac3p=-3.0D0*fac3*rrmij
13162 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
13163 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
13165 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
13166 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
13167 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
13168 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
13169 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
13170 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
13171 ecosap=ecosa1+ecosa2
13172 ecosbp=ecosb1+ecosb2
13173 ecosgp=ecosg1+ecosg2
13174 ecosam=ecosa1-ecosa2
13175 ecosbm=ecosb1-ecosb2
13176 ecosgm=ecosg1-ecosg2
13185 facont_hb(num_conti,i)=fcont
13186 fprimcont=fprimcont/rij
13187 !d facont_hb(num_conti,i)=1.0D0
13188 ! Following line is for diagnostics.
13191 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
13192 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
13195 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
13196 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
13198 gggp(1)=gggp(1)+ees0pijp*xj
13199 gggp(2)=gggp(2)+ees0pijp*yj
13200 gggp(3)=gggp(3)+ees0pijp*zj
13201 gggm(1)=gggm(1)+ees0mijp*xj
13202 gggm(2)=gggm(2)+ees0mijp*yj
13203 gggm(3)=gggm(3)+ees0mijp*zj
13204 ! Derivatives due to the contact function
13205 gacont_hbr(1,num_conti,i)=fprimcont*xj
13206 gacont_hbr(2,num_conti,i)=fprimcont*yj
13207 gacont_hbr(3,num_conti,i)=fprimcont*zj
13210 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
13211 ! following the change of gradient-summation algorithm.
13213 !grad ghalfp=0.5D0*gggp(k)
13214 !grad ghalfm=0.5D0*gggm(k)
13215 gacontp_hb1(k,num_conti,i)= & !ghalfp
13216 +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
13217 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
13218 gacontp_hb2(k,num_conti,i)= & !ghalfp
13219 +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
13220 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
13221 gacontp_hb3(k,num_conti,i)=gggp(k)
13222 gacontm_hb1(k,num_conti,i)= &!ghalfm
13223 +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
13224 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
13225 gacontm_hb2(k,num_conti,i)= & !ghalfm
13226 +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
13227 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
13228 gacontm_hb3(k,num_conti,i)=gggm(k)
13231 endif ! num_conti.le.maxconts
13234 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
13237 ghalf=0.5d0*agg(l,k)
13238 aggi(l,k)=aggi(l,k)+ghalf
13239 aggi1(l,k)=aggi1(l,k)+agg(l,k)
13240 aggj(l,k)=aggj(l,k)+ghalf
13243 if (j.eq.nres-1 .and. i.lt.j-2) then
13246 aggj1(l,k)=aggj1(l,k)+agg(l,k)
13251 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
13253 end subroutine eelecij_scale
13254 !-----------------------------------------------------------------------------
13255 subroutine evdwpp_short(evdw1)
13259 ! implicit real*8 (a-h,o-z)
13260 ! include 'DIMENSIONS'
13261 ! include 'COMMON.CONTROL'
13262 ! include 'COMMON.IOUNITS'
13263 ! include 'COMMON.GEO'
13264 ! include 'COMMON.VAR'
13265 ! include 'COMMON.LOCAL'
13266 ! include 'COMMON.CHAIN'
13267 ! include 'COMMON.DERIV'
13268 ! include 'COMMON.INTERACT'
13269 ! include 'COMMON.CONTACTS'
13270 ! include 'COMMON.TORSION'
13271 ! include 'COMMON.VECTORS'
13272 ! include 'COMMON.FFIELD'
13273 real(kind=8),dimension(3) :: ggg
13274 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13276 real(kind=8) :: scal_el=1.0d0
13278 real(kind=8) :: scal_el=0.5d0
13280 !el local variables
13281 integer :: i,j,k,iteli,itelj,num_conti
13282 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
13283 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
13284 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13285 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
13288 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
13289 ! & " iatel_e_vdw",iatel_e_vdw
13291 do i=iatel_s_vdw,iatel_e_vdw
13292 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle
13296 dx_normi=dc_norm(1,i)
13297 dy_normi=dc_norm(2,i)
13298 dz_normi=dc_norm(3,i)
13299 xmedi=c(1,i)+0.5d0*dxi
13300 ymedi=c(2,i)+0.5d0*dyi
13301 zmedi=c(3,i)+0.5d0*dzi
13303 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
13304 ! & ' ielend',ielend_vdw(i)
13306 do j=ielstart_vdw(i),ielend_vdw(i)
13307 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
13311 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
13312 aaa=app(iteli,itelj)
13313 bbb=bpp(iteli,itelj)
13317 dx_normj=dc_norm(1,j)
13318 dy_normj=dc_norm(2,j)
13319 dz_normj=dc_norm(3,j)
13320 xj=c(1,j)+0.5D0*dxj-xmedi
13321 yj=c(2,j)+0.5D0*dyj-ymedi
13322 zj=c(3,j)+0.5D0*dzj-zmedi
13323 rij=xj*xj+yj*yj+zj*zj
13326 sss=sscale(rij/rpp(iteli,itelj))
13327 if (sss.gt.0.0d0) then
13332 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
13333 if (j.eq.i+2) ev1=scal_el*ev1
13336 if (energy_dec) then
13337 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
13339 evdw1=evdw1+evdwij*sss
13341 ! Calculate contributions to the Cartesian gradient.
13343 facvdw=-6*rrmij*(ev1+evdwij)*sss
13348 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
13349 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
13355 end subroutine evdwpp_short
13356 !-----------------------------------------------------------------------------
13357 subroutine escp_long(evdw2,evdw2_14)
13359 ! This subroutine calculates the excluded-volume interaction energy between
13360 ! peptide-group centers and side chains and its gradient in virtual-bond and
13361 ! side-chain vectors.
13363 ! implicit real*8 (a-h,o-z)
13364 ! include 'DIMENSIONS'
13365 ! include 'COMMON.GEO'
13366 ! include 'COMMON.VAR'
13367 ! include 'COMMON.LOCAL'
13368 ! include 'COMMON.CHAIN'
13369 ! include 'COMMON.DERIV'
13370 ! include 'COMMON.INTERACT'
13371 ! include 'COMMON.FFIELD'
13372 ! include 'COMMON.IOUNITS'
13373 ! include 'COMMON.CONTROL'
13374 real(kind=8),dimension(3) :: ggg
13375 !el local variables
13376 integer :: i,iint,j,k,iteli,itypj
13377 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2
13378 real(kind=8) :: evdw2,evdw2_14,evdwij
13381 !d print '(a)','Enter ESCP'
13382 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
13383 do i=iatscp_s,iatscp_e
13384 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
13386 xi=0.5D0*(c(1,i)+c(1,i+1))
13387 yi=0.5D0*(c(2,i)+c(2,i+1))
13388 zi=0.5D0*(c(3,i)+c(3,i+1))
13390 do iint=1,nscp_gr(i)
13392 do j=iscpstart(i,iint),iscpend(i,iint)
13394 if (itypj.eq.ntyp1) cycle
13395 ! Uncomment following three lines for SC-p interactions
13396 ! xj=c(1,nres+j)-xi
13397 ! yj=c(2,nres+j)-yi
13398 ! zj=c(3,nres+j)-zi
13399 ! Uncomment following three lines for Ca-p interactions
13403 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13405 sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
13407 if (sss.lt.1.0d0) then
13410 e1=fac*fac*aad(itypj,iteli)
13411 e2=fac*bad(itypj,iteli)
13412 if (iabs(j-i) .le. 2) then
13415 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)
13418 evdw2=evdw2+evdwij*(1.0d0-sss)
13419 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
13420 'evdw2',i,j,sss,evdwij
13422 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
13424 fac=-(evdwij+e1)*rrij*(1.0d0-sss)
13428 ! Uncomment following three lines for SC-p interactions
13430 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
13432 ! Uncomment following line for SC-p interactions
13433 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
13435 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
13436 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
13445 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
13446 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
13447 gradx_scp(j,i)=expon*gradx_scp(j,i)
13450 !******************************************************************************
13454 ! To save time the factor EXPON has been extracted from ALL components
13455 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
13458 !******************************************************************************
13460 end subroutine escp_long
13461 !-----------------------------------------------------------------------------
13462 subroutine escp_short(evdw2,evdw2_14)
13464 ! This subroutine calculates the excluded-volume interaction energy between
13465 ! peptide-group centers and side chains and its gradient in virtual-bond and
13466 ! side-chain vectors.
13468 ! implicit real*8 (a-h,o-z)
13469 ! include 'DIMENSIONS'
13470 ! include 'COMMON.GEO'
13471 ! include 'COMMON.VAR'
13472 ! include 'COMMON.LOCAL'
13473 ! include 'COMMON.CHAIN'
13474 ! include 'COMMON.DERIV'
13475 ! include 'COMMON.INTERACT'
13476 ! include 'COMMON.FFIELD'
13477 ! include 'COMMON.IOUNITS'
13478 ! include 'COMMON.CONTROL'
13479 real(kind=8),dimension(3) :: ggg
13480 !el local variables
13481 integer :: i,iint,j,k,iteli,itypj
13482 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2
13483 real(kind=8) :: evdw2,evdw2_14,evdwij
13486 !d print '(a)','Enter ESCP'
13487 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
13488 do i=iatscp_s,iatscp_e
13489 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
13491 xi=0.5D0*(c(1,i)+c(1,i+1))
13492 yi=0.5D0*(c(2,i)+c(2,i+1))
13493 zi=0.5D0*(c(3,i)+c(3,i+1))
13495 do iint=1,nscp_gr(i)
13497 do j=iscpstart(i,iint),iscpend(i,iint)
13499 if (itypj.eq.ntyp1) cycle
13500 ! Uncomment following three lines for SC-p interactions
13501 ! xj=c(1,nres+j)-xi
13502 ! yj=c(2,nres+j)-yi
13503 ! zj=c(3,nres+j)-zi
13504 ! Uncomment following three lines for Ca-p interactions
13508 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13510 sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
13512 if (sss.gt.0.0d0) then
13515 e1=fac*fac*aad(itypj,iteli)
13516 e2=fac*bad(itypj,iteli)
13517 if (iabs(j-i) .le. 2) then
13520 evdw2_14=evdw2_14+(e1+e2)*sss
13523 evdw2=evdw2+evdwij*sss
13524 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
13525 'evdw2',i,j,sss,evdwij
13527 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
13529 fac=-(evdwij+e1)*rrij*sss
13533 ! Uncomment following three lines for SC-p interactions
13535 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
13537 ! Uncomment following line for SC-p interactions
13538 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
13540 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
13541 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
13550 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
13551 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
13552 gradx_scp(j,i)=expon*gradx_scp(j,i)
13555 !******************************************************************************
13559 ! To save time the factor EXPON has been extracted from ALL components
13560 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
13563 !******************************************************************************
13565 end subroutine escp_short
13566 !-----------------------------------------------------------------------------
13567 ! energy_p_new-sep_barrier.F
13568 !-----------------------------------------------------------------------------
13569 subroutine sc_grad_scale(scalfac)
13570 ! implicit real*8 (a-h,o-z)
13572 ! include 'DIMENSIONS'
13573 ! include 'COMMON.CHAIN'
13574 ! include 'COMMON.DERIV'
13575 ! include 'COMMON.CALC'
13576 ! include 'COMMON.IOUNITS'
13577 real(kind=8),dimension(3) :: dcosom1,dcosom2
13578 real(kind=8) :: scalfac
13579 !el local variables
13580 ! integer :: i,j,k,l
13582 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
13583 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
13584 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
13585 -2.0D0*alf12*eps3der+sigder*sigsq_om12
13589 ! eom12=evdwij*eps1_om12
13591 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
13592 ! & " sigder",sigder
13593 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
13594 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
13596 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
13597 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
13600 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
13603 ! write (iout,*) "gg",(gg(k),k=1,3)
13605 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
13606 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
13607 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
13609 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
13610 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
13611 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
13613 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
13614 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
13615 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
13616 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
13619 ! Calculate the components of the gradient in DC and X
13622 gvdwc(l,i)=gvdwc(l,i)-gg(l)
13623 gvdwc(l,j)=gvdwc(l,j)+gg(l)
13626 end subroutine sc_grad_scale
13627 !-----------------------------------------------------------------------------
13628 ! energy_split-sep.F
13629 !-----------------------------------------------------------------------------
13630 subroutine etotal_long(energia)
13632 ! Compute the long-range slow-varying contributions to the energy
13634 ! implicit real*8 (a-h,o-z)
13635 ! include 'DIMENSIONS'
13636 use MD_data, only: totT,usampl,eq_time
13640 !MS$ATTRIBUTES C :: proc_proc
13645 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
13647 ! include 'COMMON.SETUP'
13648 ! include 'COMMON.IOUNITS'
13649 ! include 'COMMON.FFIELD'
13650 ! include 'COMMON.DERIV'
13651 ! include 'COMMON.INTERACT'
13652 ! include 'COMMON.SBRIDGE'
13653 ! include 'COMMON.CHAIN'
13654 ! include 'COMMON.VAR'
13655 ! include 'COMMON.LOCAL'
13656 ! include 'COMMON.MD'
13657 real(kind=8),dimension(0:n_ene) :: energia
13658 !el local variables
13659 integer :: i,n_corr,n_corr1,ierror,ierr
13660 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
13661 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
13662 ecorr,ecorr5,ecorr6,eturn6,time00
13663 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
13664 !elwrite(iout,*)"in etotal long"
13666 if (modecalc.eq.12.or.modecalc.eq.14) then
13668 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
13670 call int_from_cart1(.false.)
13673 !elwrite(iout,*)"in etotal long"
13676 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
13677 ! & " absolute rank",myrank," nfgtasks",nfgtasks
13679 if (nfgtasks.gt.1) then
13681 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
13682 if (fg_rank.eq.0) then
13683 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
13684 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
13686 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
13687 ! FG slaves as WEIGHTS array.
13694 weights_(7)=wel_loc
13697 weights_(10)=wturn6
13699 weights_(12)=wscloc
13701 weights_(14)=wtor_d
13702 weights_(15)=wstrain
13703 weights_(16)=wvdwpp
13705 weights_(18)=scal14
13706 weights_(21)=wsccor
13707 ! FG Master broadcasts the WEIGHTS_ array
13708 call MPI_Bcast(weights_(1),n_ene,&
13709 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13711 ! FG slaves receive the WEIGHTS array
13712 call MPI_Bcast(weights(1),n_ene,&
13713 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13728 wstrain=weights(15)
13734 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
13736 time_Bcast=time_Bcast+MPI_Wtime()-time00
13737 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
13738 ! call chainbuild_cart
13739 ! call int_from_cart1(.false.)
13741 ! write (iout,*) 'Processor',myrank,
13742 ! & ' calling etotal_short ipot=',ipot
13744 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
13746 !d print *,'nnt=',nnt,' nct=',nct
13748 !elwrite(iout,*)"in etotal long"
13749 ! Compute the side-chain and electrostatic interaction energy
13751 goto (101,102,103,104,105,106) ipot
13752 ! Lennard-Jones potential.
13753 101 call elj_long(evdw)
13754 !d print '(a)','Exit ELJ'
13756 ! Lennard-Jones-Kihara potential (shifted).
13757 102 call eljk_long(evdw)
13759 ! Berne-Pechukas potential (dilated LJ, angular dependence).
13760 103 call ebp_long(evdw)
13762 ! Gay-Berne potential (shifted LJ, angular dependence).
13763 104 call egb_long(evdw)
13765 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
13766 105 call egbv_long(evdw)
13768 ! Soft-sphere potential
13769 106 call e_softsphere(evdw)
13771 ! Calculate electrostatic (H-bonding) energy of the main chain.
13775 if (ipot.lt.6) then
13777 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
13778 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
13779 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
13780 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
13782 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
13783 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
13784 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
13785 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
13787 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13796 ! write (iout,*) "Soft-spheer ELEC potential"
13797 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
13801 ! Calculate excluded-volume interaction energy between peptide groups
13804 if (ipot.lt.6) then
13805 if(wscp.gt.0d0) then
13806 call escp_long(evdw2,evdw2_14)
13812 call escp_soft_sphere(evdw2,evdw2_14)
13815 ! 12/1/95 Multi-body terms
13819 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
13820 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
13821 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
13822 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
13823 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
13830 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
13831 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
13834 ! If performing constraint dynamics, call the constraint energy
13835 ! after the equilibration time
13836 if(usampl.and.totT.gt.eq_time) then
13851 energia(2)=evdw2-evdw2_14
13852 energia(18)=evdw2_14
13861 energia(3)=ees+evdw1
13868 energia(8)=eello_turn3
13869 energia(9)=eello_turn4
13871 energia(20)=Uconst+Uconst_back
13872 call sum_energy(energia,.true.)
13873 ! write (iout,*) "Exit ETOTAL_LONG"
13876 end subroutine etotal_long
13877 !-----------------------------------------------------------------------------
13878 subroutine etotal_short(energia)
13880 ! Compute the short-range fast-varying contributions to the energy
13882 ! implicit real*8 (a-h,o-z)
13883 ! include 'DIMENSIONS'
13887 !MS$ATTRIBUTES C :: proc_proc
13892 integer :: ierror,ierr
13893 real(kind=8),dimension(n_ene) :: weights_
13894 real(kind=8) :: time00
13896 ! include 'COMMON.SETUP'
13897 ! include 'COMMON.IOUNITS'
13898 ! include 'COMMON.FFIELD'
13899 ! include 'COMMON.DERIV'
13900 ! include 'COMMON.INTERACT'
13901 ! include 'COMMON.SBRIDGE'
13902 ! include 'COMMON.CHAIN'
13903 ! include 'COMMON.VAR'
13904 ! include 'COMMON.LOCAL'
13905 real(kind=8),dimension(0:n_ene) :: energia
13906 !el local variables
13908 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
13909 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr
13912 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
13914 if (modecalc.eq.12.or.modecalc.eq.14) then
13916 if (fg_rank.eq.0) call int_from_cart1(.false.)
13918 call int_from_cart1(.false.)
13922 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
13923 ! & " absolute rank",myrank," nfgtasks",nfgtasks
13925 if (nfgtasks.gt.1) then
13927 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
13928 if (fg_rank.eq.0) then
13929 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
13930 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
13932 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
13933 ! FG slaves as WEIGHTS array.
13940 weights_(7)=wel_loc
13943 weights_(10)=wturn6
13945 weights_(12)=wscloc
13947 weights_(14)=wtor_d
13948 weights_(15)=wstrain
13949 weights_(16)=wvdwpp
13951 weights_(18)=scal14
13952 weights_(21)=wsccor
13953 ! FG Master broadcasts the WEIGHTS_ array
13954 call MPI_Bcast(weights_(1),n_ene,&
13955 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13957 ! FG slaves receive the WEIGHTS array
13958 call MPI_Bcast(weights(1),n_ene,&
13959 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13974 wstrain=weights(15)
13980 ! write (iout,*),"Processor",myrank," BROADCAST weights"
13981 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
13983 ! write (iout,*) "Processor",myrank," BROADCAST c"
13984 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
13986 ! write (iout,*) "Processor",myrank," BROADCAST dc"
13987 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
13989 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
13990 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
13992 ! write (iout,*) "Processor",myrank," BROADCAST theta"
13993 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
13995 ! write (iout,*) "Processor",myrank," BROADCAST phi"
13996 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
13998 ! write (iout,*) "Processor",myrank," BROADCAST alph"
13999 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
14001 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
14002 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
14004 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
14005 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
14007 time_Bcast=time_Bcast+MPI_Wtime()-time00
14008 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
14010 ! write (iout,*) 'Processor',myrank,
14011 ! & ' calling etotal_short ipot=',ipot
14013 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
14015 ! call int_from_cart1(.false.)
14017 ! Compute the side-chain and electrostatic interaction energy
14019 goto (101,102,103,104,105,106) ipot
14020 ! Lennard-Jones potential.
14021 101 call elj_short(evdw)
14022 !d print '(a)','Exit ELJ'
14024 ! Lennard-Jones-Kihara potential (shifted).
14025 102 call eljk_short(evdw)
14027 ! Berne-Pechukas potential (dilated LJ, angular dependence).
14028 103 call ebp_short(evdw)
14030 ! Gay-Berne potential (shifted LJ, angular dependence).
14031 104 call egb_short(evdw)
14033 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
14034 105 call egbv_short(evdw)
14036 ! Soft-sphere potential - already dealt with in the long-range part
14038 ! 106 call e_softsphere_short(evdw)
14040 ! Calculate electrostatic (H-bonding) energy of the main chain.
14044 ! Calculate the short-range part of Evdwpp
14046 call evdwpp_short(evdw1)
14048 ! Calculate the short-range part of ESCp
14050 if (ipot.lt.6) then
14051 call escp_short(evdw2,evdw2_14)
14054 ! Calculate the bond-stretching energy
14058 ! Calculate the disulfide-bridge and other energy and the contributions
14059 ! from other distance constraints.
14062 ! Calculate the virtual-bond-angle energy.
14066 ! Calculate the SC local energy.
14071 ! Calculate the virtual-bond torsional energy.
14073 call etor(etors,edihcnstr)
14075 ! 6/23/01 Calculate double-torsional energy
14077 call etor_d(etors_d)
14079 ! 21/5/07 Calculate local sicdechain correlation energy
14081 if (wsccor.gt.0.0d0) then
14082 call eback_sc_corr(esccor)
14087 ! Put energy components into an array
14094 energia(2)=evdw2-evdw2_14
14095 energia(18)=evdw2_14
14108 energia(14)=etors_d
14111 energia(19)=edihcnstr
14113 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
14115 call sum_energy(energia,.true.)
14116 ! write (iout,*) "Exit ETOTAL_SHORT"
14119 end subroutine etotal_short
14120 !-----------------------------------------------------------------------------
14122 !-----------------------------------------------------------------------------
14123 real(kind=8) function gnmr1(y,ymin,ymax)
14125 real(kind=8) :: y,ymin,ymax
14126 real(kind=8) :: wykl=4.0d0
14127 if (y.lt.ymin) then
14128 gnmr1=(ymin-y)**wykl/wykl
14129 else if (y.gt.ymax) then
14130 gnmr1=(y-ymax)**wykl/wykl
14136 !-----------------------------------------------------------------------------
14137 real(kind=8) function gnmr1prim(y,ymin,ymax)
14139 real(kind=8) :: y,ymin,ymax
14140 real(kind=8) :: wykl=4.0d0
14141 if (y.lt.ymin) then
14142 gnmr1prim=-(ymin-y)**(wykl-1)
14143 else if (y.gt.ymax) then
14144 gnmr1prim=(y-ymax)**(wykl-1)
14149 end function gnmr1prim
14150 !-----------------------------------------------------------------------------
14151 real(kind=8) function harmonic(y,ymax)
14153 real(kind=8) :: y,ymax
14154 real(kind=8) :: wykl=2.0d0
14155 harmonic=(y-ymax)**wykl
14157 end function harmonic
14158 !-----------------------------------------------------------------------------
14159 real(kind=8) function harmonicprim(y,ymax)
14160 real(kind=8) :: y,ymin,ymax
14161 real(kind=8) :: wykl=2.0d0
14162 harmonicprim=(y-ymax)*wykl
14164 end function harmonicprim
14165 !-----------------------------------------------------------------------------
14167 !-----------------------------------------------------------------------------
14168 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
14170 use io_base, only:intout,briefout
14171 ! implicit real*8 (a-h,o-z)
14172 ! include 'DIMENSIONS'
14173 ! include 'COMMON.CHAIN'
14174 ! include 'COMMON.DERIV'
14175 ! include 'COMMON.VAR'
14176 ! include 'COMMON.INTERACT'
14177 ! include 'COMMON.FFIELD'
14178 ! include 'COMMON.MD'
14179 ! include 'COMMON.IOUNITS'
14180 real(kind=8),external :: ufparm
14181 integer :: uiparm(1)
14182 real(kind=8) :: urparm(1)
14183 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
14184 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
14185 integer :: n,nf,ind,ind1,i,k,j
14187 ! This subroutine calculates total internal coordinate gradient.
14188 ! Depending on the number of function evaluations, either whole energy
14189 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
14190 ! internal coordinates are reevaluated or only the cartesian-in-internal
14191 ! coordinate derivatives are evaluated. The subroutine was designed to work
14197 !d print *,'grad',nf,icg
14198 if (nf-nfl+1) 20,30,40
14199 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
14200 ! write (iout,*) 'grad 20'
14201 if (nf.eq.0) return
14203 30 call var_to_geom(n,x)
14205 ! write (iout,*) 'grad 30'
14207 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
14210 ! write (iout,*) 'grad 40'
14211 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
14213 ! Convert the Cartesian gradient into internal-coordinate gradient.
14223 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
14225 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
14228 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
14234 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
14236 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
14237 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
14240 if (i.gt.1) g(i-1)=gphii
14241 if (n.gt.nphi) g(nphi+i)=gthetai
14243 if (n.le.nphi+ntheta) goto 10
14245 if (itype(i).ne.10) then
14249 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
14252 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
14254 g(ialph(i,1))=galphai
14255 g(ialph(i,1)+nside)=gomegai
14259 ! Add the components corresponding to local energy terms.
14263 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
14264 g(i)=g(i)+gloc(i,icg)
14266 ! Uncomment following three lines for diagnostics.
14268 !elwrite(iout,*) "in gradient after calling intout"
14269 !d call briefout(0,0.0d0)
14270 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
14272 end subroutine gradient
14273 !-----------------------------------------------------------------------------
14274 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
14277 ! implicit real*8 (a-h,o-z)
14278 ! include 'DIMENSIONS'
14279 ! include 'COMMON.DERIV'
14280 ! include 'COMMON.IOUNITS'
14281 ! include 'COMMON.GEO'
14284 !el common /chuju/ jjj
14285 real(kind=8) :: energia(0:n_ene)
14286 integer :: uiparm(1)
14287 real(kind=8) :: urparm(1)
14289 real(kind=8),external :: ufparm
14290 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
14291 ! if (jjj.gt.0) then
14292 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
14296 !d print *,'func',nf,nfl,icg
14297 call var_to_geom(n,x)
14300 !d write (iout,*) 'ETOTAL called from FUNC'
14301 call etotal(energia)
14304 ! if (jjj.gt.0) then
14305 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
14306 ! write (iout,*) 'f=',etot
14310 end subroutine func
14311 !-----------------------------------------------------------------------------
14312 subroutine cartgrad
14313 ! implicit real*8 (a-h,o-z)
14314 ! include 'DIMENSIONS'
14316 use MD_data, only: totT,usampl,eq_time
14320 ! include 'COMMON.CHAIN'
14321 ! include 'COMMON.DERIV'
14322 ! include 'COMMON.VAR'
14323 ! include 'COMMON.INTERACT'
14324 ! include 'COMMON.FFIELD'
14325 ! include 'COMMON.MD'
14326 ! include 'COMMON.IOUNITS'
14327 ! include 'COMMON.TIME1'
14331 ! This subrouting calculates total Cartesian coordinate gradient.
14332 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
14342 !el write (iout,*) "After sum_gradient"
14344 !el write (iout,*) "After sum_gradient"
14346 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
14347 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
14350 ! If performing constraint dynamics, add the gradients of the constraint energy
14351 if(usampl.and.totT.gt.eq_time) then
14354 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
14355 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
14359 gloc(i,icg)=gloc(i,icg)+dugamma(i)
14362 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
14365 !elwrite (iout,*) "After sum_gradient"
14370 !elwrite (iout,*) "After sum_gradient"
14372 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
14374 ! call checkintcartgrad
14375 ! write(iout,*) 'calling int_to_cart'
14377 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
14381 gcart(j,i)=gradc(j,i,icg)
14382 gxcart(j,i)=gradx(j,i,icg)
14385 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
14386 (gxcart(j,i),j=1,3),gloc(i,icg)
14394 time_inttocart=time_inttocart+MPI_Wtime()-time01
14397 write (iout,*) "gcart and gxcart after int_to_cart"
14399 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
14400 (gxcart(j,i),j=1,3)
14405 write (iout,*) "CARGRAD"
14409 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
14410 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
14412 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
14413 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
14415 ! Correction: dummy residues
14418 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
14419 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
14422 if (nct.lt.nres) then
14424 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
14425 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
14430 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
14434 end subroutine cartgrad
14435 !-----------------------------------------------------------------------------
14436 subroutine zerograd
14437 ! implicit real*8 (a-h,o-z)
14438 ! include 'DIMENSIONS'
14439 ! include 'COMMON.DERIV'
14440 ! include 'COMMON.CHAIN'
14441 ! include 'COMMON.VAR'
14442 ! include 'COMMON.MD'
14443 ! include 'COMMON.SCCOR'
14445 !el local variables
14446 integer :: i,j,intertyp
14447 ! Initialize Cartesian-coordinate gradient
14449 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
14450 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
14452 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
14453 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
14454 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
14455 ! allocate(gradcorr_long(3,nres))
14456 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
14457 ! allocate(gcorr6_turn_long(3,nres))
14458 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
14460 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
14462 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
14463 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
14465 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
14466 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
14468 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
14469 ! allocate(gscloc(3,nres)) !(3,maxres)
14470 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
14474 ! common /deriv_scloc/
14475 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
14476 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
14477 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
14479 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
14483 ! gradc(j,i,icg)=0.0d0
14484 ! gradx(j,i,icg)=0.0d0
14486 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
14487 !elwrite(iout,*) "icg",icg
14491 gradx_scp(j,i)=0.0D0
14493 gvdwc_scp(j,i)=0.0D0
14494 gvdwc_scpp(j,i)=0.0d0
14496 gelc_long(j,i)=0.0D0
14501 gel_loc_long(j,i)=0.0d0
14504 gcorr3_turn(j,i)=0.0d0
14505 gcorr4_turn(j,i)=0.0d0
14506 gradcorr(j,i)=0.0d0
14507 gradcorr_long(j,i)=0.0d0
14508 gradcorr5_long(j,i)=0.0d0
14509 gradcorr6_long(j,i)=0.0d0
14510 gcorr6_turn_long(j,i)=0.0d0
14511 gradcorr5(j,i)=0.0d0
14512 gradcorr6(j,i)=0.0d0
14513 gcorr6_turn(j,i)=0.0d0
14516 gradc(j,i,icg)=0.0d0
14517 gradx(j,i,icg)=0.0d0
14521 gloc_sc(intertyp,i,icg)=0.0d0
14526 ! Initialize the gradient of local energy terms.
14528 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
14529 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
14530 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
14531 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
14532 ! allocate(gel_loc_turn3(nres))
14533 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
14534 ! allocate(gsccor_loc(nres)) !(maxres)
14540 gel_loc_loc(i)=0.0d0
14542 g_corr5_loc(i)=0.0d0
14543 g_corr6_loc(i)=0.0d0
14544 gel_loc_turn3(i)=0.0d0
14545 gel_loc_turn4(i)=0.0d0
14546 gel_loc_turn6(i)=0.0d0
14547 gsccor_loc(i)=0.0d0
14549 ! initialize gcart and gxcart
14550 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
14558 end subroutine zerograd
14559 !-----------------------------------------------------------------------------
14560 real(kind=8) function fdum()
14564 !-----------------------------------------------------------------------------
14566 !-----------------------------------------------------------------------------
14567 subroutine intcartderiv
14568 ! implicit real*8 (a-h,o-z)
14569 ! include 'DIMENSIONS'
14573 ! include 'COMMON.SETUP'
14574 ! include 'COMMON.CHAIN'
14575 ! include 'COMMON.VAR'
14576 ! include 'COMMON.GEO'
14577 ! include 'COMMON.INTERACT'
14578 ! include 'COMMON.DERIV'
14579 ! include 'COMMON.IOUNITS'
14580 ! include 'COMMON.LOCAL'
14581 ! include 'COMMON.SCCOR'
14582 real(kind=8) :: pi4,pi34
14583 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
14584 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
14585 dcosomega,dsinomega !(3,3,maxres)
14586 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
14589 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
14590 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
14591 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
14592 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
14596 !el from module energy-------------
14597 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
14598 !el allocate(dsintau(3,3,3,itau_start:itau_end))
14599 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
14601 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
14602 !el allocate(dsintau(3,3,3,0:nres2))
14603 !el allocate(dtauangle(3,3,3,0:nres2))
14604 !el allocate(domicron(3,2,2,0:nres2))
14605 !el allocate(dcosomicron(3,2,2,0:nres2))
14609 #if defined(MPI) && defined(PARINTDER)
14610 if (nfgtasks.gt.1 .and. me.eq.king) &
14611 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
14616 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
14617 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
14619 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
14622 dtheta(j,1,i)=0.0d0
14623 dtheta(j,2,i)=0.0d0
14629 ! Derivatives of theta's
14630 #if defined(MPI) && defined(PARINTDER)
14631 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
14632 do i=max0(ithet_start-1,3),ithet_end
14636 cost=dcos(theta(i))
14637 sint=sqrt(1-cost*cost)
14639 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
14641 if (itype(i-1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
14642 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
14644 if (itype(i-1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
14647 #if defined(MPI) && defined(PARINTDER)
14648 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
14649 do i=max0(ithet_start-1,3),ithet_end
14653 if ((itype(i-1).ne.10).and.(itype(i-1).ne.ntyp1)) then
14654 cost1=dcos(omicron(1,i))
14655 sint1=sqrt(1-cost1*cost1)
14656 cost2=dcos(omicron(2,i))
14657 sint2=sqrt(1-cost2*cost2)
14659 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
14660 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
14661 cost1*dc_norm(j,i-2))/ &
14663 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
14664 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
14665 +cost1*(dc_norm(j,i-1+nres)))/ &
14667 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
14668 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
14669 !C Looks messy but better than if in loop
14670 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
14671 +cost2*dc_norm(j,i-1))/ &
14673 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
14674 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
14675 +cost2*(-dc_norm(j,i-1+nres)))/ &
14677 ! write(iout,*) "vbld", i,itype(i),vbld(i-1+nres)
14678 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
14682 !elwrite(iout,*) "after vbld write"
14683 ! Derivatives of phi:
14684 ! If phi is 0 or 180 degrees, then the formulas
14685 ! have to be derived by power series expansion of the
14686 ! conventional formulas around 0 and 180.
14688 do i=iphi1_start,iphi1_end
14692 ! if (itype(i-1).eq.21 .or. itype(i-2).eq.21 ) cycle
14693 ! the conventional case
14694 sint=dsin(theta(i))
14695 sint1=dsin(theta(i-1))
14697 cost=dcos(theta(i))
14698 cost1=dcos(theta(i-1))
14700 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
14701 fac0=1.0d0/(sint1*sint)
14704 fac3=cosg*cost1/(sint1*sint1)
14705 fac4=cosg*cost/(sint*sint)
14706 ! Obtaining the gamma derivatives from sine derivative
14707 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
14708 phi(i).gt.pi34.and.phi(i).le.pi.or. &
14709 phi(i).gt.-pi.and.phi(i).le.-pi34) then
14710 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
14711 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
14712 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
14716 cosg_inv=1.0d0/cosg
14717 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
14718 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
14719 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
14720 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
14722 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
14723 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14724 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
14725 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
14726 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
14727 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14728 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
14730 ! Bug fixed 3/24/05 (AL)
14732 ! Obtaining the gamma derivatives from cosine derivative
14735 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
14736 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
14737 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
14738 dc_norm(j,i-3))/vbld(i-2)
14739 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
14740 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
14741 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
14743 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
14744 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
14745 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
14746 dc_norm(j,i-1))/vbld(i)
14747 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
14752 !alculate derivative of Tauangle
14754 do i=itau_start,itau_end
14757 !elwrite(iout,*) " vecpr",i,nres
14759 if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
14760 ! if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10).or.
14761 ! & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1)) cycle
14762 !c dtauangle(j,intertyp,dervityp,residue number)
14763 !c INTERTYP=1 SC...Ca...Ca..Ca
14764 ! the conventional case
14765 sint=dsin(theta(i))
14766 sint1=dsin(omicron(2,i-1))
14767 sing=dsin(tauangle(1,i))
14768 cost=dcos(theta(i))
14769 cost1=dcos(omicron(2,i-1))
14770 cosg=dcos(tauangle(1,i))
14771 !elwrite(iout,*) " vecpr5",i,nres
14773 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
14774 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
14775 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
14776 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
14778 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
14779 fac0=1.0d0/(sint1*sint)
14782 fac3=cosg*cost1/(sint1*sint1)
14783 fac4=cosg*cost/(sint*sint)
14784 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
14785 ! Obtaining the gamma derivatives from sine derivative
14786 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
14787 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
14788 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
14789 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
14790 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
14791 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
14795 cosg_inv=1.0d0/cosg
14796 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
14797 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
14798 *vbld_inv(i-2+nres)
14799 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
14800 dsintau(j,1,2,i)= &
14801 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
14802 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14803 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
14804 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
14805 ! Bug fixed 3/24/05 (AL)
14806 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
14807 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
14808 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14809 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
14811 ! Obtaining the gamma derivatives from cosine derivative
14814 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
14815 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
14816 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
14817 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
14818 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
14819 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
14821 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
14822 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
14823 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
14824 dc_norm(j,i-1))/vbld(i)
14825 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
14826 ! write (iout,*) "else",i
14830 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
14833 !C Second case Ca...Ca...Ca...SC
14835 do i=itau_start,itau_end
14839 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
14840 (itype(i-2).eq.ntyp1).or.(itype(i-3).eq.ntyp1)) cycle
14841 ! the conventional case
14842 sint=dsin(omicron(1,i))
14843 sint1=dsin(theta(i-1))
14844 sing=dsin(tauangle(2,i))
14845 cost=dcos(omicron(1,i))
14846 cost1=dcos(theta(i-1))
14847 cosg=dcos(tauangle(2,i))
14849 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
14851 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
14852 fac0=1.0d0/(sint1*sint)
14855 fac3=cosg*cost1/(sint1*sint1)
14856 fac4=cosg*cost/(sint*sint)
14857 ! Obtaining the gamma derivatives from sine derivative
14858 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
14859 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
14860 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
14861 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
14862 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
14863 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
14867 cosg_inv=1.0d0/cosg
14868 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
14869 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
14870 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
14871 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
14872 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
14873 dsintau(j,2,2,i)= &
14874 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
14875 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14876 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
14877 ! & sing*ctgt*domicron(j,1,2,i),
14878 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14879 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
14880 ! Bug fixed 3/24/05 (AL)
14881 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
14882 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
14883 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14884 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
14886 ! Obtaining the gamma derivatives from cosine derivative
14889 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
14890 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
14891 dc_norm(j,i-3))/vbld(i-2)
14892 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
14893 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
14894 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
14895 dcosomicron(j,1,1,i)
14896 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
14897 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
14898 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
14899 dc_norm(j,i-1+nres))/vbld(i-1+nres)
14900 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
14901 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
14906 !CC third case SC...Ca...Ca...SC
14909 do i=itau_start,itau_end
14913 ! the conventional case
14914 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
14915 (itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
14916 sint=dsin(omicron(1,i))
14917 sint1=dsin(omicron(2,i-1))
14918 sing=dsin(tauangle(3,i))
14919 cost=dcos(omicron(1,i))
14920 cost1=dcos(omicron(2,i-1))
14921 cosg=dcos(tauangle(3,i))
14923 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
14924 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
14926 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
14927 fac0=1.0d0/(sint1*sint)
14930 fac3=cosg*cost1/(sint1*sint1)
14931 fac4=cosg*cost/(sint*sint)
14932 ! Obtaining the gamma derivatives from sine derivative
14933 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
14934 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
14935 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
14936 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
14937 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
14938 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
14942 cosg_inv=1.0d0/cosg
14943 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
14944 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
14945 *vbld_inv(i-2+nres)
14946 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
14947 dsintau(j,3,2,i)= &
14948 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
14949 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14950 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
14951 ! Bug fixed 3/24/05 (AL)
14952 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
14953 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
14954 *vbld_inv(i-1+nres)
14955 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14956 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
14958 ! Obtaining the gamma derivatives from cosine derivative
14961 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
14962 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
14963 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
14964 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
14965 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
14966 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
14967 dcosomicron(j,1,1,i)
14968 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
14969 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
14970 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
14971 dc_norm(j,i-1+nres))/vbld(i-1+nres)
14972 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
14973 ! write(iout,*) "else",i
14979 ! Derivatives of side-chain angles alpha and omega
14980 #if defined(MPI) && defined(PARINTDER)
14981 do i=ibond_start,ibond_end
14985 if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then
14986 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
14989 fac8=fac5/vbld(i+1)
14990 fac9=fac5/vbld(i+nres)
14991 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
14992 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
14993 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
14994 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
14995 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
14996 sina=sqrt(1-cosa*cosa)
14998 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
15000 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
15001 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
15002 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
15003 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
15004 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
15005 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
15006 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
15007 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
15009 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
15011 ! obtaining the derivatives of omega from sines
15012 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
15013 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
15014 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
15015 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
15017 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
15018 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
15019 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
15020 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
15021 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
15022 coso_inv=1.0d0/dcos(omeg(i))
15024 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
15025 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
15026 (sino*dc_norm(j,i-1))/vbld(i)
15027 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
15028 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
15029 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
15030 -sino*dc_norm(j,i)/vbld(i+1)
15031 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
15032 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
15033 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
15035 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
15038 ! obtaining the derivatives of omega from cosines
15039 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
15040 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
15045 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
15046 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
15047 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
15048 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
15049 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
15050 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
15051 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
15052 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
15053 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
15054 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
15055 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
15056 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
15057 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
15058 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
15059 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
15065 dalpha(k,j,i)=0.0d0
15066 domega(k,j,i)=0.0d0
15072 #if defined(MPI) && defined(PARINTDER)
15073 if (nfgtasks.gt.1) then
15075 !d write (iout,*) "Gather dtheta"
15076 !d call flush(iout)
15077 write (iout,*) "dtheta before gather"
15079 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
15082 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
15083 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
15084 king,FG_COMM,IERROR)
15086 !d write (iout,*) "Gather dphi"
15087 !d call flush(iout)
15088 write (iout,*) "dphi before gather"
15090 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
15093 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
15094 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
15095 king,FG_COMM,IERROR)
15096 !d write (iout,*) "Gather dalpha"
15097 !d call flush(iout)
15099 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
15100 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
15101 king,FG_COMM,IERROR)
15102 !d write (iout,*) "Gather domega"
15103 !d call flush(iout)
15104 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
15105 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
15106 king,FG_COMM,IERROR)
15111 write (iout,*) "dtheta after gather"
15113 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
15115 write (iout,*) "dphi after gather"
15117 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
15119 write (iout,*) "dalpha after gather"
15121 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
15123 write (iout,*) "domega after gather"
15125 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
15129 end subroutine intcartderiv
15130 !-----------------------------------------------------------------------------
15131 subroutine checkintcartgrad
15132 ! implicit real*8 (a-h,o-z)
15133 ! include 'DIMENSIONS'
15137 ! include 'COMMON.CHAIN'
15138 ! include 'COMMON.VAR'
15139 ! include 'COMMON.GEO'
15140 ! include 'COMMON.INTERACT'
15141 ! include 'COMMON.DERIV'
15142 ! include 'COMMON.IOUNITS'
15143 ! include 'COMMON.SETUP'
15144 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
15145 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
15146 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
15147 real(kind=8),dimension(3) :: dc_norm_s
15148 real(kind=8) :: aincr=1.0d-5
15150 real(kind=8) :: dcji
15153 theta_s(i)=theta(i)
15157 ! Check theta gradient
15159 "Analytical (upper) and numerical (lower) gradient of theta"
15164 dc(j,i-2)=dcji+aincr
15165 call chainbuild_cart
15166 call int_from_cart1(.false.)
15167 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
15170 dc(j,i-1)=dc(j,i-1)+aincr
15171 call chainbuild_cart
15172 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
15175 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
15176 !el (dtheta(j,2,i),j=1,3)
15177 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
15178 !el (dthetanum(j,2,i),j=1,3)
15179 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
15180 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
15181 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
15184 ! Check gamma gradient
15186 "Analytical (upper) and numerical (lower) gradient of gamma"
15190 dc(j,i-3)=dcji+aincr
15191 call chainbuild_cart
15192 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
15195 dc(j,i-2)=dcji+aincr
15196 call chainbuild_cart
15197 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
15200 dc(j,i-1)=dc(j,i-1)+aincr
15201 call chainbuild_cart
15202 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
15205 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
15206 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
15207 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
15208 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
15209 !el write (iout,'(5x,3(3f10.5,5x))') &
15210 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
15211 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
15212 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
15215 ! Check alpha gradient
15217 "Analytical (upper) and numerical (lower) gradient of alpha"
15219 if(itype(i).ne.10) then
15222 dc(j,i-1)=dcji+aincr
15223 call chainbuild_cart
15224 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
15229 call chainbuild_cart
15230 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
15234 dc(j,i+nres)=dc(j,i+nres)+aincr
15235 call chainbuild_cart
15236 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
15241 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
15242 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
15243 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
15244 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
15245 !el write (iout,'(5x,3(3f10.5,5x))') &
15246 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
15247 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
15248 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
15251 ! Check omega gradient
15253 "Analytical (upper) and numerical (lower) gradient of omega"
15255 if(itype(i).ne.10) then
15258 dc(j,i-1)=dcji+aincr
15259 call chainbuild_cart
15260 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
15265 call chainbuild_cart
15266 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
15270 dc(j,i+nres)=dc(j,i+nres)+aincr
15271 call chainbuild_cart
15272 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
15277 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
15278 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
15279 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
15280 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
15281 !el write (iout,'(5x,3(3f10.5,5x))') &
15282 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
15283 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
15284 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
15288 end subroutine checkintcartgrad
15289 !-----------------------------------------------------------------------------
15291 !-----------------------------------------------------------------------------
15292 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
15293 ! implicit real*8 (a-h,o-z)
15294 ! include 'DIMENSIONS'
15295 ! include 'COMMON.IOUNITS'
15296 ! include 'COMMON.CHAIN'
15297 ! include 'COMMON.INTERACT'
15298 ! include 'COMMON.VAR'
15299 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
15300 integer :: kkk,nsep=3
15301 real(kind=8) :: qm !dist,
15302 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
15303 logical :: lprn=.false.
15305 ! real(kind=8) :: sigm,x
15307 !el sigm(x)=0.25d0*x ! local function
15313 do il=seg1+nsep,seg2
15316 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
15317 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
15318 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
15320 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
15321 if (itype(il).ne.10 .or. itype(jl).ne.10) then
15324 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
15325 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
15326 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
15327 dijCM=dist(il+nres,jl+nres)
15328 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
15330 qq = qq+qqij+qqijCM
15336 if((seg3-il).lt.3) then
15343 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
15344 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
15345 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
15347 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
15348 if (itype(il).ne.10 .or. itype(jl).ne.10) then
15351 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
15352 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
15353 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
15354 dijCM=dist(il+nres,jl+nres)
15355 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
15357 qq = qq+qqij+qqijCM
15362 if (qqmax.le.qq) qqmax=qq
15364 qwolynes=1.0d0-qqmax
15366 end function qwolynes
15367 !-----------------------------------------------------------------------------
15368 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
15369 ! implicit real*8 (a-h,o-z)
15370 ! include 'DIMENSIONS'
15371 ! include 'COMMON.IOUNITS'
15372 ! include 'COMMON.CHAIN'
15373 ! include 'COMMON.INTERACT'
15374 ! include 'COMMON.VAR'
15375 ! include 'COMMON.MD'
15376 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
15377 integer :: nsep=3, kkk
15378 !el real(kind=8) :: dist
15379 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
15380 logical :: lprn=.false.
15382 real(kind=8) :: sim,dd0,fac,ddqij
15383 !el sigm(x)=0.25d0*x ! local function
15393 do il=seg1+nsep,seg2
15396 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
15397 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
15398 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
15400 sim = 1.0d0/sigm(d0ij)
15403 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
15405 ddqij = (c(k,il)-c(k,jl))*fac
15406 dqwol(k,il)=dqwol(k,il)+ddqij
15407 dqwol(k,jl)=dqwol(k,jl)-ddqij
15410 if (itype(il).ne.10 .or. itype(jl).ne.10) then
15413 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
15414 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
15415 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
15416 dijCM=dist(il+nres,jl+nres)
15417 sim = 1.0d0/sigm(d0ijCM)
15420 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
15422 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
15423 dxqwol(k,il)=dxqwol(k,il)+ddqij
15424 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
15431 if((seg3-il).lt.3) then
15438 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
15439 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
15440 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
15442 sim = 1.0d0/sigm(d0ij)
15445 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
15447 ddqij = (c(k,il)-c(k,jl))*fac
15448 dqwol(k,il)=dqwol(k,il)+ddqij
15449 dqwol(k,jl)=dqwol(k,jl)-ddqij
15451 if (itype(il).ne.10 .or. itype(jl).ne.10) then
15454 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
15455 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
15456 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
15457 dijCM=dist(il+nres,jl+nres)
15458 sim = 1.0d0/sigm(d0ijCM)
15461 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
15463 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
15464 dxqwol(k,il)=dxqwol(k,il)+ddqij
15465 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
15474 dqwol(j,i)=dqwol(j,i)/nl
15475 dxqwol(j,i)=dxqwol(j,i)/nl
15479 end subroutine qwolynes_prim
15480 !-----------------------------------------------------------------------------
15481 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
15482 ! implicit real*8 (a-h,o-z)
15483 ! include 'DIMENSIONS'
15484 ! include 'COMMON.IOUNITS'
15485 ! include 'COMMON.CHAIN'
15486 ! include 'COMMON.INTERACT'
15487 ! include 'COMMON.VAR'
15488 integer :: seg1,seg2,seg3,seg4
15490 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
15491 real(kind=8),dimension(3,0:2*nres) :: cdummy
15492 real(kind=8) :: q1,q2
15493 real(kind=8) :: delta=1.0d-10
15498 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
15500 c(j,i)=c(j,i)+delta
15501 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
15502 qwolan(j,i)=(q2-q1)/delta
15508 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
15509 cdummy(j,i+nres)=c(j,i+nres)
15510 c(j,i+nres)=c(j,i+nres)+delta
15511 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
15512 qwolxan(j,i)=(q2-q1)/delta
15513 c(j,i+nres)=cdummy(j,i+nres)
15516 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
15518 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
15520 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
15522 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
15525 end subroutine qwol_num
15526 !-----------------------------------------------------------------------------
15527 subroutine EconstrQ
15528 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
15529 ! implicit real*8 (a-h,o-z)
15530 ! include 'DIMENSIONS'
15531 ! include 'COMMON.CONTROL'
15532 ! include 'COMMON.VAR'
15533 ! include 'COMMON.MD'
15536 ! include 'COMMON.LANGEVIN'
15538 ! include 'COMMON.LANGEVIN.lang0'
15540 ! include 'COMMON.CHAIN'
15541 ! include 'COMMON.DERIV'
15542 ! include 'COMMON.GEO'
15543 ! include 'COMMON.LOCAL'
15544 ! include 'COMMON.INTERACT'
15545 ! include 'COMMON.IOUNITS'
15546 ! include 'COMMON.NAMES'
15547 ! include 'COMMON.TIME1'
15548 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
15549 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
15551 integer :: kstart,kend,lstart,lend,idummy
15552 real(kind=8) :: delta=1.0d-7
15553 integer :: i,j,k,ii
15557 dudconst(j,i)=0.0d0
15558 duxconst(j,i)=0.0d0
15559 dudxconst(j,i)=0.0d0
15564 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
15566 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
15567 ! Calculating the derivatives of Constraint energy with respect to Q
15568 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
15570 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
15571 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
15572 ! hmnum=(hm2-hm1)/delta
15573 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
15574 ! & qinfrag(i,iset))
15575 ! write(iout,*) "harmonicnum frag", hmnum
15576 ! Calculating the derivatives of Q with respect to cartesian coordinates
15577 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
15579 ! write(iout,*) "dqwol "
15581 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
15583 ! write(iout,*) "dxqwol "
15585 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
15587 ! Calculating numerical gradients of dU/dQi and dQi/dxi
15588 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
15589 ! & ,idummy,idummy)
15590 ! The gradients of Uconst in Cs
15593 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
15594 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
15599 kstart=ifrag(1,ipair(1,i,iset),iset)
15600 kend=ifrag(2,ipair(1,i,iset),iset)
15601 lstart=ifrag(1,ipair(2,i,iset),iset)
15602 lend=ifrag(2,ipair(2,i,iset),iset)
15603 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
15604 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
15605 ! Calculating dU/dQ
15606 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
15607 ! hm1=harmonic(qpair(i),qinpair(i,iset))
15608 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
15609 ! hmnum=(hm2-hm1)/delta
15610 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
15611 ! & qinpair(i,iset))
15612 ! write(iout,*) "harmonicnum pair ", hmnum
15613 ! Calculating dQ/dXi
15614 call qwolynes_prim(kstart,kend,.false.,&
15616 ! write(iout,*) "dqwol "
15618 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
15620 ! write(iout,*) "dxqwol "
15622 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
15624 ! Calculating numerical gradients
15625 ! call qwol_num(kstart,kend,.false.
15627 ! The gradients of Uconst in Cs
15630 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
15631 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
15635 ! write(iout,*) "Uconst inside subroutine ", Uconst
15636 ! Transforming the gradients from Cs to dCs for the backbone
15640 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
15644 ! Transforming the gradients from Cs to dCs for the side chains
15647 dudxconst(j,i)=duxconst(j,i)
15650 ! write(iout,*) "dU/ddc backbone "
15652 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
15654 ! write(iout,*) "dU/ddX side chain "
15656 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
15658 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
15659 ! call dEconstrQ_num
15661 end subroutine EconstrQ
15662 !-----------------------------------------------------------------------------
15663 subroutine dEconstrQ_num
15664 ! Calculating numerical dUconst/ddc and dUconst/ddx
15665 ! implicit real*8 (a-h,o-z)
15666 ! include 'DIMENSIONS'
15667 ! include 'COMMON.CONTROL'
15668 ! include 'COMMON.VAR'
15669 ! include 'COMMON.MD'
15672 ! include 'COMMON.LANGEVIN'
15674 ! include 'COMMON.LANGEVIN.lang0'
15676 ! include 'COMMON.CHAIN'
15677 ! include 'COMMON.DERIV'
15678 ! include 'COMMON.GEO'
15679 ! include 'COMMON.LOCAL'
15680 ! include 'COMMON.INTERACT'
15681 ! include 'COMMON.IOUNITS'
15682 ! include 'COMMON.NAMES'
15683 ! include 'COMMON.TIME1'
15684 real(kind=8) :: uzap1,uzap2
15685 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
15686 integer :: kstart,kend,lstart,lend,idummy
15687 real(kind=8) :: delta=1.0d-7
15688 !el local variables
15694 dUcartan(j,i)=0.0d0
15695 cdummy(j,i)=dc(j,i)
15696 dc(j,i)=dc(j,i)+delta
15697 call chainbuild_cart
15700 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15702 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
15706 kstart=ifrag(1,ipair(1,ii,iset),iset)
15707 kend=ifrag(2,ipair(1,ii,iset),iset)
15708 lstart=ifrag(1,ipair(2,ii,iset),iset)
15709 lend=ifrag(2,ipair(2,ii,iset),iset)
15710 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15711 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
15714 dc(j,i)=cdummy(j,i)
15715 call chainbuild_cart
15718 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15720 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
15724 kstart=ifrag(1,ipair(1,ii,iset),iset)
15725 kend=ifrag(2,ipair(1,ii,iset),iset)
15726 lstart=ifrag(1,ipair(2,ii,iset),iset)
15727 lend=ifrag(2,ipair(2,ii,iset),iset)
15728 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15729 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
15732 ducartan(j,i)=(uzap2-uzap1)/(delta)
15735 ! Calculating numerical gradients for dU/ddx
15737 duxcartan(j,i)=0.0d0
15739 cdummy(j,i)=dc(j,i+nres)
15740 dc(j,i+nres)=dc(j,i+nres)+delta
15741 call chainbuild_cart
15744 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15746 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
15750 kstart=ifrag(1,ipair(1,ii,iset),iset)
15751 kend=ifrag(2,ipair(1,ii,iset),iset)
15752 lstart=ifrag(1,ipair(2,ii,iset),iset)
15753 lend=ifrag(2,ipair(2,ii,iset),iset)
15754 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15755 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
15758 dc(j,i+nres)=cdummy(j,i)
15759 call chainbuild_cart
15762 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
15763 ifrag(2,ii,iset),.true.,idummy,idummy)
15764 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
15768 kstart=ifrag(1,ipair(1,ii,iset),iset)
15769 kend=ifrag(2,ipair(1,ii,iset),iset)
15770 lstart=ifrag(1,ipair(2,ii,iset),iset)
15771 lend=ifrag(2,ipair(2,ii,iset),iset)
15772 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15773 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
15776 duxcartan(j,i)=(uzap2-uzap1)/(delta)
15779 write(iout,*) "Numerical dUconst/ddc backbone "
15781 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
15783 ! write(iout,*) "Numerical dUconst/ddx side-chain "
15785 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
15788 end subroutine dEconstrQ_num
15789 !-----------------------------------------------------------------------------
15791 !-----------------------------------------------------------------------------
15792 subroutine check_energies
15794 ! use random, only: ran_number
15798 ! include 'DIMENSIONS'
15799 ! include 'COMMON.CHAIN'
15800 ! include 'COMMON.VAR'
15801 ! include 'COMMON.IOUNITS'
15802 ! include 'COMMON.SBRIDGE'
15803 ! include 'COMMON.LOCAL'
15804 ! include 'COMMON.GEO'
15806 ! External functions
15807 !EL double precision ran_number
15808 !EL external ran_number
15811 integer :: i,j,k,l,lmax,p,pmax
15812 real(kind=8) :: rmin,rmax
15813 real(kind=8) :: eij
15816 real(kind=8) :: wi,rij,tj,pj
15838 !t wi=ran_number(0.0D0,pi)
15839 ! wi=ran_number(0.0D0,pi/6.0D0)
15841 !t tj=ran_number(0.0D0,pi)
15842 !t pj=ran_number(0.0D0,pi)
15843 ! pj=ran_number(0.0D0,pi/6.0D0)
15847 !t rij=ran_number(rmin,rmax)
15849 c(1,j)=d*sin(pj)*cos(tj)
15850 c(2,j)=d*sin(pj)*sin(tj)
15856 c(3,i)=-rij-d*cos(wi)
15859 dc(k,nres+i)=c(k,nres+i)-c(k,i)
15860 dc_norm(k,nres+i)=dc(k,nres+i)/d
15861 dc(k,nres+j)=c(k,nres+j)-c(k,j)
15862 dc_norm(k,nres+j)=dc(k,nres+j)/d
15865 call dyn_ssbond_ene(i,j,eij)
15870 end subroutine check_energies
15871 !-----------------------------------------------------------------------------
15872 subroutine dyn_ssbond_ene(resi,resj,eij)
15877 ! include 'DIMENSIONS'
15878 ! include 'COMMON.SBRIDGE'
15879 ! include 'COMMON.CHAIN'
15880 ! include 'COMMON.DERIV'
15881 ! include 'COMMON.LOCAL'
15882 ! include 'COMMON.INTERACT'
15883 ! include 'COMMON.VAR'
15884 ! include 'COMMON.IOUNITS'
15885 ! include 'COMMON.CALC'
15889 ! include 'COMMON.MD'
15890 ! use MD, only: totT,t_bath
15893 ! External functions
15894 !EL double precision h_base
15895 !EL external h_base
15898 integer :: resi,resj
15901 real(kind=8) :: eij
15904 logical :: havebond
15905 integer itypi,itypj
15906 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
15907 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
15908 real(kind=8),dimension(3) :: dcosom1,dcosom2
15910 real(kind=8) :: pom1,pom2
15911 real(kind=8) :: ljA,ljB,ljXs
15912 real(kind=8),dimension(1:3) :: d_ljB
15913 real(kind=8) :: ssA,ssB,ssC,ssXs
15914 real(kind=8) :: ssxm,ljxm,ssm,ljm
15915 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
15916 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
15917 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
15918 !-------FIRST METHOD
15920 real(kind=8),dimension(1:3) :: d_xm
15921 !-------END FIRST METHOD
15922 !-------SECOND METHOD
15923 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
15924 !-------END SECOND METHOD
15926 !-------TESTING CODE
15927 !el logical :: checkstop,transgrad
15928 !el common /sschecks/ checkstop,transgrad
15930 integer :: icheck,nicheck,jcheck,njcheck
15931 real(kind=8),dimension(-1:1) :: echeck
15932 real(kind=8) :: deps,ssx0,ljx0
15933 !-------END TESTING CODE
15939 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
15940 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
15943 dxi=dc_norm(1,nres+i)
15944 dyi=dc_norm(2,nres+i)
15945 dzi=dc_norm(3,nres+i)
15946 dsci_inv=vbld_inv(i+nres)
15949 xj=c(1,nres+j)-c(1,nres+i)
15950 yj=c(2,nres+j)-c(2,nres+i)
15951 zj=c(3,nres+j)-c(3,nres+i)
15952 dxj=dc_norm(1,nres+j)
15953 dyj=dc_norm(2,nres+j)
15954 dzj=dc_norm(3,nres+j)
15955 dscj_inv=vbld_inv(j+nres)
15957 chi1=chi(itypi,itypj)
15958 chi2=chi(itypj,itypi)
15965 alf12=0.5D0*(alf1+alf2)
15967 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15968 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
15969 ! The following are set in sc_angular
15973 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
15974 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
15975 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
15977 rij=1.0D0/rij ! Reset this so it makes sense
15979 sig0ij=sigma(itypi,itypj)
15980 sig=sig0ij*dsqrt(1.0D0/sigsq)
15983 ljA=eps1*eps2rt**2*eps3rt**2
15984 ljB=ljA*bb(itypi,itypj)
15985 ljA=ljA*aa(itypi,itypj)
15986 ljxm=ljXs+(-2.0D0*aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
15991 deltat12=om2-om1+2.0d0
15992 cosphi=om12-om1*om2
15996 +akth*(deltat1*deltat1+deltat2*deltat2) &
15997 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
15998 ssxm=ssXs-0.5D0*ssB/ssA
16000 !-------TESTING CODE
16001 !$$$c Some extra output
16002 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
16003 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
16004 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
16005 !$$$ if (ssx0.gt.0.0d0) then
16006 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
16010 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
16011 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
16012 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
16014 !-------END TESTING CODE
16016 !-------TESTING CODE
16017 ! Stop and plot energy and derivative as a function of distance
16018 if (checkstop) then
16019 ssm=ssC-0.25D0*ssB*ssB/ssA
16020 ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
16021 if (ssm.lt.ljm .and. &
16022 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
16030 if (.not.checkstop) then
16035 do icheck=0,nicheck
16036 do jcheck=-1,njcheck
16037 if (checkstop) rij=(ssxm-1.0d0)+ &
16038 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
16039 !-------END TESTING CODE
16041 if (rij.gt.ljxm) then
16044 fac=(1.0D0/ljd)**expon
16045 e1=fac*fac*aa(itypi,itypj)
16046 e2=fac*bb(itypi,itypj)
16047 eij=eps1*eps2rt*eps3rt*(e1+e2)
16050 eij=eij*eps2rt*eps3rt
16053 e1=e1*eps1*eps2rt**2*eps3rt**2
16054 ed=-expon*(e1+eij)/ljd
16056 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
16057 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
16058 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
16059 -2.0D0*alf12*eps3der+sigder*sigsq_om12
16060 else if (rij.lt.ssxm) then
16063 eij=ssA*ssd*ssd+ssB*ssd+ssC
16065 ed=2*akcm*ssd+akct*deltat12
16067 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
16068 eom1=-2*akth*deltat1-pom1-om2*pom2
16069 eom2= 2*akth*deltat2+pom1-om1*pom2
16072 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
16074 d_ssxm(1)=0.5D0*akct/ssA
16075 d_ssxm(2)=-d_ssxm(1)
16078 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
16079 d_ljxm(2)=d_ljxm(1)*sigsq_om2
16080 d_ljxm(3)=d_ljxm(1)*sigsq_om12
16081 d_ljxm(1)=d_ljxm(1)*sigsq_om1
16083 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
16084 xm=0.5d0*(ssxm+ljxm)
16086 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
16088 if (rij.lt.xm) then
16090 ssm=ssC-0.25D0*ssB*ssB/ssA
16091 d_ssm(1)=0.5D0*akct*ssB/ssA
16092 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
16093 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
16095 f1=(rij-xm)/(ssxm-xm)
16096 f2=(rij-ssxm)/(xm-ssxm)
16100 delta_inv=1.0d0/(xm-ssxm)
16101 deltasq_inv=delta_inv*delta_inv
16103 fac1=deltasq_inv*fac*(xm-rij)
16104 fac2=deltasq_inv*fac*(rij-ssxm)
16105 ed=delta_inv*(Ht*hd2-ssm*hd1)
16106 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
16107 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
16108 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
16111 ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
16112 d_ljm(1)=-0.5D0*bb(itypi,itypj)/aa(itypi,itypj)*ljB
16113 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
16114 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
16116 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
16117 f1=(rij-ljxm)/(xm-ljxm)
16118 f2=(rij-xm)/(ljxm-xm)
16122 delta_inv=1.0d0/(ljxm-xm)
16123 deltasq_inv=delta_inv*delta_inv
16125 fac1=deltasq_inv*fac*(ljxm-rij)
16126 fac2=deltasq_inv*fac*(rij-xm)
16127 ed=delta_inv*(ljm*hd2-Ht*hd1)
16128 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
16129 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
16130 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
16132 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
16134 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
16140 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
16141 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
16142 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
16144 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
16145 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
16146 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
16147 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
16148 !$$$ d_ssm(3)=omega
16150 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
16152 !$$$ d_ljm(k)=ljm*d_ljB(k)
16156 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
16157 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
16158 !$$$ d_ss(2)=akct*ssd
16159 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
16160 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
16163 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
16164 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
16165 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
16167 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
16168 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
16170 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
16172 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
16173 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
16174 !$$$ h1=h_base(f1,hd1)
16175 !$$$ h2=h_base(f2,hd2)
16176 !$$$ eij=ss*h1+ljf*h2
16177 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
16178 !$$$ deltasq_inv=delta_inv*delta_inv
16179 !$$$ fac=ljf*hd2-ss*hd1
16180 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
16181 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
16182 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
16183 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
16184 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
16185 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
16186 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
16188 !$$$ havebond=.false.
16189 !$$$ if (ed.gt.0.0d0) havebond=.true.
16190 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
16197 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
16198 ! write(iout,'(a15,f12.2,f8.1,2i5)')
16199 ! & "SSBOND_E_FORM",totT,t_bath,i,j
16203 dyn_ssbond_ij(i,j)=eij
16204 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
16205 dyn_ssbond_ij(i,j)=1.0d300
16208 ! write(iout,'(a15,f12.2,f8.1,2i5)')
16209 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
16214 !-------TESTING CODE
16215 !el if (checkstop) then
16216 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
16217 "CHECKSTOP",rij,eij,ed
16221 if (checkstop) then
16222 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
16225 if (checkstop) then
16229 !-------END TESTING CODE
16232 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
16233 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
16236 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
16239 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
16240 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
16241 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
16242 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
16243 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
16244 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
16248 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
16253 gvdwc(l,i)=gvdwc(l,i)-gg(l)
16254 gvdwc(l,j)=gvdwc(l,j)+gg(l)
16258 end subroutine dyn_ssbond_ene
16259 !-----------------------------------------------------------------------------
16260 real(kind=8) function h_base(x,deriv)
16261 ! A smooth function going 0->1 in range [0,1]
16262 ! It should NOT be called outside range [0,1], it will not work there.
16269 real(kind=8) :: deriv
16272 real(kind=8) :: xsq
16275 ! Two parabolas put together. First derivative zero at extrema
16276 !$$$ if (x.lt.0.5D0) then
16277 !$$$ h_base=2.0D0*x*x
16281 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
16282 !$$$ deriv=4.0D0*deriv
16285 ! Third degree polynomial. First derivative zero at extrema
16286 h_base=x*x*(3.0d0-2.0d0*x)
16287 deriv=6.0d0*x*(1.0d0-x)
16289 ! Fifth degree polynomial. First and second derivatives zero at extrema
16291 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
16293 !$$$ deriv=deriv*deriv
16294 !$$$ deriv=30.0d0*xsq*deriv
16297 end function h_base
16298 !-----------------------------------------------------------------------------
16299 subroutine dyn_set_nss
16300 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
16302 use MD_data, only: totT,t_bath
16304 ! include 'DIMENSIONS'
16308 ! include 'COMMON.SBRIDGE'
16309 ! include 'COMMON.CHAIN'
16310 ! include 'COMMON.IOUNITS'
16311 ! include 'COMMON.SETUP'
16312 ! include 'COMMON.MD'
16314 real(kind=8) :: emin
16315 integer :: i,j,imin,ierr
16316 integer :: diff,allnss,newnss
16317 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
16320 integer,dimension(0:nfgtasks) :: i_newnss
16321 integer,dimension(0:nfgtasks) :: displ
16322 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
16323 integer :: g_newnss
16328 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
16337 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
16341 if (allflag(i).eq.0 .and. &
16342 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
16343 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
16347 if (emin.lt.1.0d300) then
16350 if (allflag(i).eq.0 .and. &
16351 (allihpb(i).eq.allihpb(imin) .or. &
16352 alljhpb(i).eq.allihpb(imin) .or. &
16353 allihpb(i).eq.alljhpb(imin) .or. &
16354 alljhpb(i).eq.alljhpb(imin))) then
16361 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
16365 if (allflag(i).eq.1) then
16367 newihpb(newnss)=allihpb(i)
16368 newjhpb(newnss)=alljhpb(i)
16373 if (nfgtasks.gt.1)then
16375 call MPI_Reduce(newnss,g_newnss,1,&
16376 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
16377 call MPI_Gather(newnss,1,MPI_INTEGER,&
16378 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
16380 do i=1,nfgtasks-1,1
16381 displ(i)=i_newnss(i-1)+displ(i-1)
16383 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
16384 g_newihpb,i_newnss,displ,MPI_INTEGER,&
16386 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
16387 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
16389 if(fg_rank.eq.0) then
16390 ! print *,'g_newnss',g_newnss
16391 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
16392 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
16395 newihpb(i)=g_newihpb(i)
16396 newjhpb(i)=g_newjhpb(i)
16404 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
16409 if (idssb(i).eq.newihpb(j) .and. &
16410 jdssb(i).eq.newjhpb(j)) found=.true.
16414 if (.not.found.and.fg_rank.eq.0) &
16415 write(iout,'(a15,f12.2,f8.1,2i5)') &
16416 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
16424 if (newihpb(i).eq.idssb(j) .and. &
16425 newjhpb(i).eq.jdssb(j)) found=.true.
16429 if (.not.found.and.fg_rank.eq.0) &
16430 write(iout,'(a15,f12.2,f8.1,2i5)') &
16431 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
16438 idssb(i)=newihpb(i)
16439 jdssb(i)=newjhpb(i)
16443 end subroutine dyn_set_nss
16444 !-----------------------------------------------------------------------------
16446 subroutine read_ssHist
16449 ! include 'DIMENSIONS'
16450 ! include "DIMENSIONS.FREE"
16451 ! include 'COMMON.FREE'
16454 character(len=80) :: controlcard
16457 call card_concat(controlcard,.true.)
16458 read(controlcard,*) &
16459 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
16463 end subroutine read_ssHist
16465 !-----------------------------------------------------------------------------
16466 integer function indmat(i,j)
16468 ! get the position of the jth ijth fragment of the chain coordinate system
16469 ! in the fromto array.
16472 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
16474 end function indmat
16475 !-----------------------------------------------------------------------------
16476 real(kind=8) function sigm(x)
16482 !-----------------------------------------------------------------------------
16483 !-----------------------------------------------------------------------------
16484 subroutine alloc_ener_arrays
16485 !EL Allocation of arrays used by module energy
16486 use MD_data, only: mset
16487 !el local variables
16490 if(nres.lt.100) then
16492 elseif(nres.lt.200) then
16493 maxconts=0.8*nres ! Max. number of contacts per residue
16495 maxconts=0.6*nres ! (maxconts=maxres/4)
16497 maxcont=12*nres ! Max. number of SC contacts
16498 maxvar=6*nres ! Max. number of variables
16499 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
16500 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
16501 !----------------------
16502 ! arrays in subroutine init_int_table
16504 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
16505 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
16507 allocate(nint_gr(nres))
16508 allocate(nscp_gr(nres))
16509 allocate(ielstart(nres))
16510 allocate(ielend(nres))
16512 allocate(istart(nres,maxint_gr))
16513 allocate(iend(nres,maxint_gr))
16514 !(maxres,maxint_gr)
16515 allocate(iscpstart(nres,maxint_gr))
16516 allocate(iscpend(nres,maxint_gr))
16517 !(maxres,maxint_gr)
16518 allocate(ielstart_vdw(nres))
16519 allocate(ielend_vdw(nres))
16522 allocate(lentyp(0:nfgtasks-1))
16524 !----------------------
16526 ! common /contacts/
16527 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
16528 allocate(icont(2,maxcont))
16530 ! common /contacts1/
16531 allocate(num_cont(0:nres+4))
16533 allocate(jcont(maxconts,nres))
16535 allocate(facont(maxconts,nres))
16537 allocate(gacont(3,maxconts,nres))
16538 !(3,maxconts,maxres)
16539 ! common /contacts_hb/
16540 allocate(gacontp_hb1(3,maxconts,nres))
16541 allocate(gacontp_hb2(3,maxconts,nres))
16542 allocate(gacontp_hb3(3,maxconts,nres))
16543 allocate(gacontm_hb1(3,maxconts,nres))
16544 allocate(gacontm_hb2(3,maxconts,nres))
16545 allocate(gacontm_hb3(3,maxconts,nres))
16546 allocate(gacont_hbr(3,maxconts,nres))
16547 allocate(grij_hb_cont(3,maxconts,nres))
16548 !(3,maxconts,maxres)
16549 allocate(facont_hb(maxconts,nres))
16550 allocate(ees0p(maxconts,nres))
16551 allocate(ees0m(maxconts,nres))
16552 allocate(d_cont(maxconts,nres))
16554 allocate(num_cont_hb(nres))
16556 allocate(jcont_hb(maxconts,nres))
16559 allocate(Ug(2,2,nres))
16560 allocate(Ugder(2,2,nres))
16561 allocate(Ug2(2,2,nres))
16562 allocate(Ug2der(2,2,nres))
16564 allocate(obrot(2,nres))
16565 allocate(obrot2(2,nres))
16566 allocate(obrot_der(2,nres))
16567 allocate(obrot2_der(2,nres))
16569 ! common /precomp1/
16570 allocate(mu(2,nres))
16571 allocate(muder(2,nres))
16572 allocate(Ub2(2,nres))
16575 allocate(Ub2der(2,nres))
16576 allocate(Ctobr(2,nres))
16577 allocate(Ctobrder(2,nres))
16578 allocate(Dtobr2(2,nres))
16579 allocate(Dtobr2der(2,nres))
16581 allocate(EUg(2,2,nres))
16582 allocate(EUgder(2,2,nres))
16583 allocate(CUg(2,2,nres))
16584 allocate(CUgder(2,2,nres))
16585 allocate(DUg(2,2,nres))
16586 allocate(Dugder(2,2,nres))
16587 allocate(DtUg2(2,2,nres))
16588 allocate(DtUg2der(2,2,nres))
16590 ! common /precomp2/
16591 allocate(Ug2Db1t(2,nres))
16592 allocate(Ug2Db1tder(2,nres))
16593 allocate(CUgb2(2,nres))
16594 allocate(CUgb2der(2,nres))
16596 allocate(EUgC(2,2,nres))
16597 allocate(EUgCder(2,2,nres))
16598 allocate(EUgD(2,2,nres))
16599 allocate(EUgDder(2,2,nres))
16600 allocate(DtUg2EUg(2,2,nres))
16601 allocate(Ug2DtEUg(2,2,nres))
16603 allocate(Ug2DtEUgder(2,2,2,nres))
16604 allocate(DtUg2EUgder(2,2,2,nres))
16606 ! common /rotat_old/
16607 allocate(costab(nres))
16608 allocate(sintab(nres))
16609 allocate(costab2(nres))
16610 allocate(sintab2(nres))
16613 allocate(a_chuj(2,2,maxconts,nres))
16614 !(2,2,maxconts,maxres)(maxconts=maxres/4)
16615 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
16616 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
16617 ! common /contdistrib/
16618 allocate(ncont_sent(nres))
16619 allocate(ncont_recv(nres))
16621 allocate(iat_sent(nres))
16623 allocate(iint_sent(4,nres,nres))
16624 allocate(iint_sent_local(4,nres,nres))
16626 allocate(iturn3_sent(4,0:nres+4))
16627 allocate(iturn4_sent(4,0:nres+4))
16628 allocate(iturn3_sent_local(4,nres))
16629 allocate(iturn4_sent_local(4,nres))
16631 allocate(itask_cont_from(0:nfgtasks-1))
16632 allocate(itask_cont_to(0:nfgtasks-1))
16633 !(0:max_fg_procs-1)
16637 !----------------------
16640 allocate(dcdv(6,maxdim))
16641 allocate(dxdv(6,maxdim))
16643 allocate(dxds(6,nres))
16645 allocate(gradx(3,nres,0:2))
16646 allocate(gradc(3,nres,0:2))
16648 allocate(gvdwx(3,nres))
16649 allocate(gvdwc(3,nres))
16650 allocate(gelc(3,nres))
16651 allocate(gelc_long(3,nres))
16652 allocate(gvdwpp(3,nres))
16653 allocate(gvdwc_scpp(3,nres))
16654 allocate(gradx_scp(3,nres))
16655 allocate(gvdwc_scp(3,nres))
16656 allocate(ghpbx(3,nres))
16657 allocate(ghpbc(3,nres))
16658 allocate(gradcorr(3,nres))
16659 allocate(gradcorr_long(3,nres))
16660 allocate(gradcorr5_long(3,nres))
16661 allocate(gradcorr6_long(3,nres))
16662 allocate(gcorr6_turn_long(3,nres))
16663 allocate(gradxorr(3,nres))
16664 allocate(gradcorr5(3,nres))
16665 allocate(gradcorr6(3,nres))
16667 allocate(gloc(0:maxvar,0:2))
16668 allocate(gloc_x(0:maxvar,2))
16670 allocate(gel_loc(3,nres))
16671 allocate(gel_loc_long(3,nres))
16672 allocate(gcorr3_turn(3,nres))
16673 allocate(gcorr4_turn(3,nres))
16674 allocate(gcorr6_turn(3,nres))
16675 allocate(gradb(3,nres))
16676 allocate(gradbx(3,nres))
16678 allocate(gel_loc_loc(maxvar))
16679 allocate(gel_loc_turn3(maxvar))
16680 allocate(gel_loc_turn4(maxvar))
16681 allocate(gel_loc_turn6(maxvar))
16682 allocate(gcorr_loc(maxvar))
16683 allocate(g_corr5_loc(maxvar))
16684 allocate(g_corr6_loc(maxvar))
16686 allocate(gsccorc(3,nres))
16687 allocate(gsccorx(3,nres))
16689 allocate(gsccor_loc(nres))
16691 allocate(dtheta(3,2,nres))
16693 allocate(gscloc(3,nres))
16694 allocate(gsclocx(3,nres))
16696 allocate(dphi(3,3,nres))
16697 allocate(dalpha(3,3,nres))
16698 allocate(domega(3,3,nres))
16700 ! common /deriv_scloc/
16701 allocate(dXX_C1tab(3,nres))
16702 allocate(dYY_C1tab(3,nres))
16703 allocate(dZZ_C1tab(3,nres))
16704 allocate(dXX_Ctab(3,nres))
16705 allocate(dYY_Ctab(3,nres))
16706 allocate(dZZ_Ctab(3,nres))
16707 allocate(dXX_XYZtab(3,nres))
16708 allocate(dYY_XYZtab(3,nres))
16709 allocate(dZZ_XYZtab(3,nres))
16712 allocate(jgrad_start(nres))
16713 allocate(jgrad_end(nres))
16715 !----------------------
16718 allocate(ibond_displ(0:nfgtasks-1))
16719 allocate(ibond_count(0:nfgtasks-1))
16720 allocate(ithet_displ(0:nfgtasks-1))
16721 allocate(ithet_count(0:nfgtasks-1))
16722 allocate(iphi_displ(0:nfgtasks-1))
16723 allocate(iphi_count(0:nfgtasks-1))
16724 allocate(iphi1_displ(0:nfgtasks-1))
16725 allocate(iphi1_count(0:nfgtasks-1))
16726 allocate(ivec_displ(0:nfgtasks-1))
16727 allocate(ivec_count(0:nfgtasks-1))
16728 allocate(iset_displ(0:nfgtasks-1))
16729 allocate(iset_count(0:nfgtasks-1))
16730 allocate(iint_count(0:nfgtasks-1))
16731 allocate(iint_displ(0:nfgtasks-1))
16732 !(0:max_fg_procs-1)
16733 !----------------------
16736 allocate(gcart(3,0:nres))
16737 allocate(gxcart(3,0:nres))
16739 allocate(gradcag(3,nres))
16740 allocate(gradxag(3,nres))
16742 ! common /back_constr/
16743 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
16744 allocate(dutheta(nres))
16745 allocate(dugamma(nres))
16747 allocate(duscdiff(3,nres))
16748 allocate(duscdiffx(3,nres))
16750 !el i io:read_fragments
16751 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
16752 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
16754 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
16755 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
16756 allocate(mset(0:nprocs)) !(maxprocs/20)
16758 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
16759 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
16760 allocate(dUdconst(3,0:nres))
16761 allocate(dUdxconst(3,0:nres))
16762 allocate(dqwol(3,0:nres))
16763 allocate(dxqwol(3,0:nres))
16765 !----------------------
16767 ! common /sbridge/ in io_common: read_bridge
16768 !el allocate((:),allocatable :: iss !(maxss)
16769 ! common /links/ in io_common: read_bridge
16770 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
16771 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
16772 ! common /dyn_ssbond/
16773 ! and side-chain vectors in theta or phi.
16774 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
16778 dyn_ssbond_ij(:,:)=1.0d300
16783 allocate(idssb(nss),jdssb(nss))
16786 allocate(dyn_ss_mask(nres))
16788 dyn_ss_mask(:)=.false.
16789 !----------------------
16791 ! Parameters of the SCCOR term
16793 !el in io_conf: parmread
16794 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
16795 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
16796 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
16797 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
16798 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
16799 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
16800 ! allocate(vlor1sccor(maxterm_sccor,20,20))
16801 ! allocate(vlor2sccor(maxterm_sccor,20,20))
16802 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
16804 allocate(gloc_sc(3,0:2*nres,0:10))
16805 !(3,0:maxres2,10)maxres2=2*maxres
16806 allocate(dcostau(3,3,3,2*nres))
16807 allocate(dsintau(3,3,3,2*nres))
16808 allocate(dtauangle(3,3,3,2*nres))
16809 allocate(dcosomicron(3,3,3,2*nres))
16810 allocate(domicron(3,3,3,2*nres))
16811 !(3,3,3,maxres2)maxres2=2*maxres
16812 !----------------------
16815 allocate(varall(maxvar))
16816 !(maxvar)(maxvar=6*maxres)
16817 allocate(mask_theta(nres))
16818 allocate(mask_phi(nres))
16819 allocate(mask_side(nres))
16821 !----------------------
16824 allocate(uy(3,nres))
16825 allocate(uz(3,nres))
16827 allocate(uygrad(3,3,2,nres))
16828 allocate(uzgrad(3,3,2,nres))
16832 end subroutine alloc_ener_arrays
16833 !-----------------------------------------------------------------------------
16834 !-----------------------------------------------------------------------------