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,xtemp
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 !C print *,xmedi,ymedi,zmedi,xj,yj,zj,boxxsize,rij
2900 sss_ele_cut=sscale_ele(rij)
2901 sss_ele_grad=sscagrad_ele(rij)
2903 ! sss_ele_grad=0.0d0
2904 ! print *,sss_ele_cut,sss_ele_grad,&
2905 ! (rij),r_cut_ele,rlamb_ele
2906 ! if (sss_ele_cut.le.0.0) go to 128
2911 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2912 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2913 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2914 fac=cosa-3.0D0*cosb*cosg
2916 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2917 if (j.eq.i+2) ev1=scal_el*ev1
2922 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2925 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
2926 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2927 ees=ees+eesij*sss_ele_cut
2928 evdw1=evdw1+evdwij*sss_ele_cut
2929 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2930 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2931 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2932 !d & xmedi,ymedi,zmedi,xj,yj,zj
2934 if (energy_dec) then
2935 ! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
2936 ! 'evdw1',i,j,evdwij,&
2937 ! iteli,itelj,aaa,evdw1
2938 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
2939 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2942 ! Calculate contributions to the Cartesian gradient.
2945 facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut
2946 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
2952 ! Radial derivatives. First process both termini of the fragment (i,j)
2954 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
2955 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
2956 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
2959 ! ghalf=0.5D0*ggg(k)
2960 ! gelc(k,i)=gelc(k,i)+ghalf
2961 ! gelc(k,j)=gelc(k,j)+ghalf
2963 ! 9/28/08 AL Gradient compotents will be summed only at the end
2965 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2966 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2969 ! Loop over residues i+1 thru j-1.
2973 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2976 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj
2977 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj
2978 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj
2980 ! ghalf=0.5D0*ggg(k)
2981 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2982 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2984 ! 9/28/08 AL Gradient compotents will be summed only at the end
2986 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2987 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2990 ! Loop over residues i+1 thru j-1.
2994 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2998 facvdw=(ev1+evdwij)*sss_ele_cut
2999 facel=(el1+eesij)*sss_ele_cut
3001 fac=-3*rrmij*(facvdw+facvdw+facel)
3006 ! Radial derivatives. First process both termini of the fragment (i,j)
3008 ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj
3009 ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj
3010 ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj
3012 ! ghalf=0.5D0*ggg(k)
3013 ! gelc(k,i)=gelc(k,i)+ghalf
3014 ! gelc(k,j)=gelc(k,j)+ghalf
3016 ! 9/28/08 AL Gradient compotents will be summed only at the end
3018 gelc_long(k,j)=gelc(k,j)+ggg(k)
3019 gelc_long(k,i)=gelc(k,i)-ggg(k)
3022 ! Loop over residues i+1 thru j-1.
3026 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3029 ! 9/28/08 AL Gradient compotents will be summed only at the end
3034 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3035 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3041 ecosa=2.0D0*fac3*fac1+fac4
3044 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3045 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3047 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3048 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3050 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3051 !d & (dcosg(k),k=1,3)
3053 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut
3056 ! ghalf=0.5D0*ggg(k)
3057 ! gelc(k,i)=gelc(k,i)+ghalf
3058 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3059 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3060 ! gelc(k,j)=gelc(k,j)+ghalf
3061 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3062 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3066 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3070 gelc(k,i)=gelc(k,i) &
3071 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3072 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
3074 gelc(k,j)=gelc(k,j) &
3075 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3076 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
3078 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3079 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3082 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3083 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
3084 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3086 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3087 ! energy of a peptide unit is assumed in the form of a second-order
3088 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3089 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3090 ! are computed for EVERY pair of non-contiguous peptide groups.
3092 if (j.lt.nres-1) then
3103 muij(kkk)=mu(k,i)*mu(l,j)
3106 !d write (iout,*) 'EELEC: i',i,' j',j
3107 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
3108 !d write(iout,*) 'muij',muij
3109 ury=scalar(uy(1,i),erij)
3110 urz=scalar(uz(1,i),erij)
3111 vry=scalar(uy(1,j),erij)
3112 vrz=scalar(uz(1,j),erij)
3113 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3114 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3115 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3116 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3117 fac=dsqrt(-ael6i)*r3ij
3122 !d write (iout,'(4i5,4f10.5)')
3123 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3124 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3125 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3126 !d & uy(:,j),uz(:,j)
3127 !d write (iout,'(4f10.5)')
3128 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3129 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3130 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
3131 !d write (iout,'(9f10.5/)')
3132 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3133 ! Derivatives of the elements of A in virtual-bond vectors
3134 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3136 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3137 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3138 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3139 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3140 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3141 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3142 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3143 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3144 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3145 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3146 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3147 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3149 ! Compute radial contributions to the gradient
3167 ! Add the contributions coming from er
3170 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3171 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3172 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3173 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3176 ! Derivatives in DC(i)
3177 !grad ghalf1=0.5d0*agg(k,1)
3178 !grad ghalf2=0.5d0*agg(k,2)
3179 !grad ghalf3=0.5d0*agg(k,3)
3180 !grad ghalf4=0.5d0*agg(k,4)
3181 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
3182 -3.0d0*uryg(k,2)*vry)!+ghalf1
3183 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
3184 -3.0d0*uryg(k,2)*vrz)!+ghalf2
3185 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
3186 -3.0d0*urzg(k,2)*vry)!+ghalf3
3187 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
3188 -3.0d0*urzg(k,2)*vrz)!+ghalf4
3189 ! Derivatives in DC(i+1)
3190 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
3191 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3192 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
3193 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3194 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
3195 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3196 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
3197 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3198 ! Derivatives in DC(j)
3199 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
3200 -3.0d0*vryg(k,2)*ury)!+ghalf1
3201 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
3202 -3.0d0*vrzg(k,2)*ury)!+ghalf2
3203 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
3204 -3.0d0*vryg(k,2)*urz)!+ghalf3
3205 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
3206 -3.0d0*vrzg(k,2)*urz)!+ghalf4
3207 ! Derivatives in DC(j+1) or DC(nres-1)
3208 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
3209 -3.0d0*vryg(k,3)*ury)
3210 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
3211 -3.0d0*vrzg(k,3)*ury)
3212 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
3213 -3.0d0*vryg(k,3)*urz)
3214 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
3215 -3.0d0*vrzg(k,3)*urz)
3216 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
3218 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3231 aggi(k,l)=-aggi(k,l)
3232 aggi1(k,l)=-aggi1(k,l)
3233 aggj(k,l)=-aggj(k,l)
3234 aggj1(k,l)=-aggj1(k,l)
3237 if (j.lt.nres-1) then
3243 aggi(k,l)=-aggi(k,l)
3244 aggi1(k,l)=-aggi1(k,l)
3245 aggj(k,l)=-aggj(k,l)
3246 aggj1(k,l)=-aggj1(k,l)
3257 aggi(k,l)=-aggi(k,l)
3258 aggi1(k,l)=-aggi1(k,l)
3259 aggj(k,l)=-aggj(k,l)
3260 aggj1(k,l)=-aggj1(k,l)
3265 IF (wel_loc.gt.0.0d0) THEN
3266 ! Contribution to the local-electrostatic energy coming from the i-j pair
3267 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
3269 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3271 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3272 'eelloc',i,j,eel_loc_ij
3273 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
3274 ! if (energy_dec) write (iout,*) "muij",muij
3275 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3277 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
3278 ! Partial derivatives in virtual-bond dihedral angles gamma
3280 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
3281 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
3282 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
3284 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
3285 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
3286 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
3288 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3290 ! ggg(1)=(agg(1,1)*muij(1)+ &
3291 ! agg(1,2)*muij(2)+agg(1,3)*muij(3)+agg(1,4)*muij(4)) &
3293 ! +eel_loc_ij*sss_ele_grad*rmij*xj
3294 ! ggg(2)=(agg(2,1)*muij(1)+ &
3295 ! agg(2,2)*muij(2)+agg(2,3)*muij(3)+agg(2,4)*muij(4)) &
3297 ! +eel_loc_ij*sss_ele_grad*rmij*yj
3298 ! ggg(3)=(agg(3,1)*muij(1)+ &
3299 ! agg(3,2)*muij(2)+agg(3,3)*muij(3)+agg(3,4)*muij(4)) &
3301 ! +eel_loc_ij*sss_ele_grad*rmij*zj
3307 ggg(l)=(agg(l,1)*muij(1)+ &
3308 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
3310 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3312 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3313 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3314 !grad ghalf=0.5d0*ggg(l)
3315 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
3316 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
3320 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3323 ! Remaining derivatives of eello
3325 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
3326 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
3328 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3329 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
3330 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) &
3331 +aggi1(l,4)*muij(4))&
3333 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3334 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
3335 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
3337 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3338 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
3339 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) &
3340 +aggj1(l,4)*muij(4))&
3342 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3345 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
3346 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
3347 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
3348 .and. num_conti.le.maxconts) then
3349 ! write (iout,*) i,j," entered corr"
3351 ! Calculate the contact function. The ith column of the array JCONT will
3352 ! contain the numbers of atoms that make contacts with the atom I (of numbers
3353 ! greater than I). The arrays FACONT and GACONT will contain the values of
3354 ! the contact function and its derivative.
3355 ! r0ij=1.02D0*rpp(iteli,itelj)
3356 ! r0ij=1.11D0*rpp(iteli,itelj)
3357 r0ij=2.20D0*rpp(iteli,itelj)
3358 ! r0ij=1.55D0*rpp(iteli,itelj)
3359 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3360 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
3361 if (fcont.gt.0.0D0) then
3362 num_conti=num_conti+1
3363 if (num_conti.gt.maxconts) then
3364 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
3365 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
3366 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
3367 ' will skip next contacts for this conf.', num_conti
3369 jcont_hb(num_conti,i)=j
3370 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
3371 !d & " jcont_hb",jcont_hb(num_conti,i)
3372 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
3373 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3374 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3376 d_cont(num_conti,i)=rij
3377 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3378 ! --- Electrostatic-interaction matrix ---
3379 a_chuj(1,1,num_conti,i)=a22
3380 a_chuj(1,2,num_conti,i)=a23
3381 a_chuj(2,1,num_conti,i)=a32
3382 a_chuj(2,2,num_conti,i)=a33
3383 ! --- Gradient of rij
3385 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3392 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3393 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3394 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3395 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3396 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3401 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3402 ! Calculate contact energies
3404 wij=cosa-3.0D0*cosb*cosg
3407 ! fac3=dsqrt(-ael6i)/r0ij**3
3408 fac3=dsqrt(-ael6i)*r3ij
3409 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3410 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3411 if (ees0tmp.gt.0) then
3412 ees0pij=dsqrt(ees0tmp)
3416 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3417 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3418 if (ees0tmp.gt.0) then
3419 ees0mij=dsqrt(ees0tmp)
3424 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
3427 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
3430 ! Diagnostics. Comment out or remove after debugging!
3431 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3432 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3433 ! ees0m(num_conti,i)=0.0D0
3435 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3436 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3437 ! Angular derivatives of the contact function
3438 ees0pij1=fac3/ees0pij
3439 ees0mij1=fac3/ees0mij
3440 fac3p=-3.0D0*fac3*rrmij
3441 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3442 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3444 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3445 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3446 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3447 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3448 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3449 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3450 ecosap=ecosa1+ecosa2
3451 ecosbp=ecosb1+ecosb2
3452 ecosgp=ecosg1+ecosg2
3453 ecosam=ecosa1-ecosa2
3454 ecosbm=ecosb1-ecosb2
3455 ecosgm=ecosg1-ecosg2
3464 facont_hb(num_conti,i)=fcont
3465 fprimcont=fprimcont/rij
3466 !d facont_hb(num_conti,i)=1.0D0
3467 ! Following line is for diagnostics.
3470 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3471 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3474 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3475 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3477 gggp(1)=gggp(1)+ees0pijp*xj &
3478 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
3479 gggp(2)=gggp(2)+ees0pijp*yj &
3480 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
3481 gggp(3)=gggp(3)+ees0pijp*zj &
3482 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
3484 gggm(1)=gggm(1)+ees0mijp*xj &
3485 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
3487 gggm(2)=gggm(2)+ees0mijp*yj &
3488 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
3490 gggm(3)=gggm(3)+ees0mijp*zj &
3491 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
3493 ! Derivatives due to the contact function
3494 gacont_hbr(1,num_conti,i)=fprimcont*xj
3495 gacont_hbr(2,num_conti,i)=fprimcont*yj
3496 gacont_hbr(3,num_conti,i)=fprimcont*zj
3499 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
3500 ! following the change of gradient-summation algorithm.
3502 !grad ghalfp=0.5D0*gggp(k)
3503 !grad ghalfm=0.5D0*gggm(k)
3504 gacontp_hb1(k,num_conti,i)= & !ghalfp+
3505 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3506 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
3509 gacontp_hb2(k,num_conti,i)= & !ghalfp+
3510 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3511 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
3514 gacontp_hb3(k,num_conti,i)=gggp(k) &
3517 gacontm_hb1(k,num_conti,i)= & !ghalfm+
3518 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3519 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
3522 gacontm_hb2(k,num_conti,i)= & !ghalfm+
3523 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3524 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
3527 gacontm_hb3(k,num_conti,i)=gggm(k) &
3531 ! Diagnostics. Comment out or remove after debugging!
3533 !diag gacontp_hb1(k,num_conti,i)=0.0D0
3534 !diag gacontp_hb2(k,num_conti,i)=0.0D0
3535 !diag gacontp_hb3(k,num_conti,i)=0.0D0
3536 !diag gacontm_hb1(k,num_conti,i)=0.0D0
3537 !diag gacontm_hb2(k,num_conti,i)=0.0D0
3538 !diag gacontm_hb3(k,num_conti,i)=0.0D0
3541 endif ! num_conti.le.maxconts
3544 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3547 ghalf=0.5d0*agg(l,k)
3548 aggi(l,k)=aggi(l,k)+ghalf
3549 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3550 aggj(l,k)=aggj(l,k)+ghalf
3553 if (j.eq.nres-1 .and. i.lt.j-2) then
3556 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3562 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
3564 end subroutine eelecij
3565 !-----------------------------------------------------------------------------
3566 subroutine eturn3(i,eello_turn3)
3567 ! Third- and fourth-order contributions from turns
3570 ! implicit real*8 (a-h,o-z)
3571 ! include 'DIMENSIONS'
3572 ! include 'COMMON.IOUNITS'
3573 ! include 'COMMON.GEO'
3574 ! include 'COMMON.VAR'
3575 ! include 'COMMON.LOCAL'
3576 ! include 'COMMON.CHAIN'
3577 ! include 'COMMON.DERIV'
3578 ! include 'COMMON.INTERACT'
3579 ! include 'COMMON.CONTACTS'
3580 ! include 'COMMON.TORSION'
3581 ! include 'COMMON.VECTORS'
3582 ! include 'COMMON.FFIELD'
3583 ! include 'COMMON.CONTROL'
3584 real(kind=8),dimension(3) :: ggg
3585 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
3586 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
3587 real(kind=8),dimension(2) :: auxvec,auxvec1
3588 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3589 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
3590 !el integer :: num_conti,j1,j2
3591 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3592 !el dz_normi,xmedi,ymedi,zmedi
3594 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3595 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3599 real(kind=8) :: eello_turn3
3602 ! write (iout,*) "eturn3",i,j,j1,j2
3607 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3609 ! Third-order contributions
3616 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3617 !d call checkint_turn3(i,a_temp,eello_turn3_num)
3618 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3619 call transpose2(auxmat(1,1),auxmat1(1,1))
3620 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3621 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3622 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3623 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3624 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
3625 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
3626 !d & ' eello_turn3_num',4*eello_turn3_num
3627 ! Derivatives in gamma(i)
3628 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3629 call transpose2(auxmat2(1,1),auxmat3(1,1))
3630 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3631 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3632 ! Derivatives in gamma(i+1)
3633 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3634 call transpose2(auxmat2(1,1),auxmat3(1,1))
3635 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3636 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
3637 +0.5d0*(pizda(1,1)+pizda(2,2))
3638 ! Cartesian derivatives
3640 ! ghalf1=0.5d0*agg(l,1)
3641 ! ghalf2=0.5d0*agg(l,2)
3642 ! ghalf3=0.5d0*agg(l,3)
3643 ! ghalf4=0.5d0*agg(l,4)
3644 a_temp(1,1)=aggi(l,1)!+ghalf1
3645 a_temp(1,2)=aggi(l,2)!+ghalf2
3646 a_temp(2,1)=aggi(l,3)!+ghalf3
3647 a_temp(2,2)=aggi(l,4)!+ghalf4
3648 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3649 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
3650 +0.5d0*(pizda(1,1)+pizda(2,2))
3651 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3652 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3653 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3654 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3655 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3656 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
3657 +0.5d0*(pizda(1,1)+pizda(2,2))
3658 a_temp(1,1)=aggj(l,1)!+ghalf1
3659 a_temp(1,2)=aggj(l,2)!+ghalf2
3660 a_temp(2,1)=aggj(l,3)!+ghalf3
3661 a_temp(2,2)=aggj(l,4)!+ghalf4
3662 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3663 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
3664 +0.5d0*(pizda(1,1)+pizda(2,2))
3665 a_temp(1,1)=aggj1(l,1)
3666 a_temp(1,2)=aggj1(l,2)
3667 a_temp(2,1)=aggj1(l,3)
3668 a_temp(2,2)=aggj1(l,4)
3669 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3670 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
3671 +0.5d0*(pizda(1,1)+pizda(2,2))
3674 end subroutine eturn3
3675 !-----------------------------------------------------------------------------
3676 subroutine eturn4(i,eello_turn4)
3677 ! Third- and fourth-order contributions from turns
3680 ! implicit real*8 (a-h,o-z)
3681 ! include 'DIMENSIONS'
3682 ! include 'COMMON.IOUNITS'
3683 ! include 'COMMON.GEO'
3684 ! include 'COMMON.VAR'
3685 ! include 'COMMON.LOCAL'
3686 ! include 'COMMON.CHAIN'
3687 ! include 'COMMON.DERIV'
3688 ! include 'COMMON.INTERACT'
3689 ! include 'COMMON.CONTACTS'
3690 ! include 'COMMON.TORSION'
3691 ! include 'COMMON.VECTORS'
3692 ! include 'COMMON.FFIELD'
3693 ! include 'COMMON.CONTROL'
3694 real(kind=8),dimension(3) :: ggg
3695 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
3696 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
3697 real(kind=8),dimension(2) :: auxvec,auxvec1
3698 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3699 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
3700 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3701 !el dz_normi,xmedi,ymedi,zmedi
3702 !el integer :: num_conti,j1,j2
3703 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3704 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3707 integer :: i,j,iti1,iti2,iti3,l
3708 real(kind=8) :: eello_turn4,s1,s2,s3
3711 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3713 ! Fourth-order contributions
3721 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3722 !d call checkint_turn4(i,a_temp,eello_turn4_num)
3723 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3728 iti1=itortyp(itype(i+1))
3729 iti2=itortyp(itype(i+2))
3730 iti3=itortyp(itype(i+3))
3731 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3732 call transpose2(EUg(1,1,i+1),e1t(1,1))
3733 call transpose2(Eug(1,1,i+2),e2t(1,1))
3734 call transpose2(Eug(1,1,i+3),e3t(1,1))
3735 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3736 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3737 s1=scalar2(b1(1,iti2),auxvec(1))
3738 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3739 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3740 s2=scalar2(b1(1,iti1),auxvec(1))
3741 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3742 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3743 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3744 eello_turn4=eello_turn4-(s1+s2+s3)
3745 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3746 'eturn4',i,j,-(s1+s2+s3)
3747 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3748 !d & ' eello_turn4_num',8*eello_turn4_num
3749 ! Derivatives in gamma(i)
3750 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3751 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3752 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3753 s1=scalar2(b1(1,iti2),auxvec(1))
3754 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3755 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3756 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3757 ! Derivatives in gamma(i+1)
3758 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3759 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3760 s2=scalar2(b1(1,iti1),auxvec(1))
3761 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3762 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3763 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3764 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3765 ! Derivatives in gamma(i+2)
3766 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3767 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3768 s1=scalar2(b1(1,iti2),auxvec(1))
3769 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3770 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3771 s2=scalar2(b1(1,iti1),auxvec(1))
3772 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3773 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3774 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3775 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3776 ! Cartesian derivatives
3777 ! Derivatives of this turn contributions in DC(i+2)
3778 if (j.lt.nres-1) then
3780 a_temp(1,1)=agg(l,1)
3781 a_temp(1,2)=agg(l,2)
3782 a_temp(2,1)=agg(l,3)
3783 a_temp(2,2)=agg(l,4)
3784 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3785 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3786 s1=scalar2(b1(1,iti2),auxvec(1))
3787 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3788 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3789 s2=scalar2(b1(1,iti1),auxvec(1))
3790 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3791 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3792 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3794 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3797 ! Remaining derivatives of this turn contribution
3799 a_temp(1,1)=aggi(l,1)
3800 a_temp(1,2)=aggi(l,2)
3801 a_temp(2,1)=aggi(l,3)
3802 a_temp(2,2)=aggi(l,4)
3803 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3804 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3805 s1=scalar2(b1(1,iti2),auxvec(1))
3806 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3807 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3808 s2=scalar2(b1(1,iti1),auxvec(1))
3809 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3810 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3811 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3812 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3813 a_temp(1,1)=aggi1(l,1)
3814 a_temp(1,2)=aggi1(l,2)
3815 a_temp(2,1)=aggi1(l,3)
3816 a_temp(2,2)=aggi1(l,4)
3817 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3818 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3819 s1=scalar2(b1(1,iti2),auxvec(1))
3820 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3821 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3822 s2=scalar2(b1(1,iti1),auxvec(1))
3823 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3824 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3825 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3826 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3827 a_temp(1,1)=aggj(l,1)
3828 a_temp(1,2)=aggj(l,2)
3829 a_temp(2,1)=aggj(l,3)
3830 a_temp(2,2)=aggj(l,4)
3831 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3832 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3833 s1=scalar2(b1(1,iti2),auxvec(1))
3834 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3835 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3836 s2=scalar2(b1(1,iti1),auxvec(1))
3837 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3838 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3839 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3840 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3841 a_temp(1,1)=aggj1(l,1)
3842 a_temp(1,2)=aggj1(l,2)
3843 a_temp(2,1)=aggj1(l,3)
3844 a_temp(2,2)=aggj1(l,4)
3845 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3846 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3847 s1=scalar2(b1(1,iti2),auxvec(1))
3848 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3849 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3850 s2=scalar2(b1(1,iti1),auxvec(1))
3851 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3852 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3853 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3854 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3855 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3858 end subroutine eturn4
3859 !-----------------------------------------------------------------------------
3860 subroutine unormderiv(u,ugrad,unorm,ungrad)
3861 ! This subroutine computes the derivatives of a normalized vector u, given
3862 ! the derivatives computed without normalization conditions, ugrad. Returns
3865 real(kind=8),dimension(3) :: u,vec
3866 real(kind=8),dimension(3,3) ::ugrad,ungrad
3867 real(kind=8) :: unorm !,scalar
3869 ! write (2,*) 'ugrad',ugrad
3872 vec(i)=scalar(ugrad(1,i),u(1))
3874 ! write (2,*) 'vec',vec
3877 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3880 ! write (2,*) 'ungrad',ungrad
3882 end subroutine unormderiv
3883 !-----------------------------------------------------------------------------
3884 subroutine escp_soft_sphere(evdw2,evdw2_14)
3886 ! This subroutine calculates the excluded-volume interaction energy between
3887 ! peptide-group centers and side chains and its gradient in virtual-bond and
3888 ! side-chain vectors.
3890 ! implicit real*8 (a-h,o-z)
3891 ! include 'DIMENSIONS'
3892 ! include 'COMMON.GEO'
3893 ! include 'COMMON.VAR'
3894 ! include 'COMMON.LOCAL'
3895 ! include 'COMMON.CHAIN'
3896 ! include 'COMMON.DERIV'
3897 ! include 'COMMON.INTERACT'
3898 ! include 'COMMON.FFIELD'
3899 ! include 'COMMON.IOUNITS'
3900 ! include 'COMMON.CONTROL'
3901 real(kind=8),dimension(3) :: ggg
3903 integer :: i,iint,j,k,iteli,itypj
3904 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
3905 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
3910 !d print '(a)','Enter ESCP'
3911 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3912 do i=iatscp_s,iatscp_e
3913 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3915 xi=0.5D0*(c(1,i)+c(1,i+1))
3916 yi=0.5D0*(c(2,i)+c(2,i+1))
3917 zi=0.5D0*(c(3,i)+c(3,i+1))
3919 do iint=1,nscp_gr(i)
3921 do j=iscpstart(i,iint),iscpend(i,iint)
3922 if (itype(j).eq.ntyp1) cycle
3923 itypj=iabs(itype(j))
3924 ! Uncomment following three lines for SC-p interactions
3928 ! Uncomment following three lines for Ca-p interactions
3932 rij=xj*xj+yj*yj+zj*zj
3935 if (rij.lt.r0ijsq) then
3936 evdwij=0.25d0*(rij-r0ijsq)**2
3944 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
3949 !grad if (j.lt.i) then
3950 !d write (iout,*) 'j<i'
3951 ! Uncomment following three lines for SC-p interactions
3953 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3956 !d write (iout,*) 'j>i'
3958 !grad ggg(k)=-ggg(k)
3959 ! Uncomment following line for SC-p interactions
3960 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3964 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3966 !grad kstart=min0(i+1,j)
3967 !grad kend=max0(i-1,j-1)
3968 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3969 !d write (iout,*) ggg(1),ggg(2),ggg(3)
3970 !grad do k=kstart,kend
3972 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3976 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3977 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3984 end subroutine escp_soft_sphere
3985 !-----------------------------------------------------------------------------
3986 subroutine escp(evdw2,evdw2_14)
3988 ! This subroutine calculates the excluded-volume interaction energy between
3989 ! peptide-group centers and side chains and its gradient in virtual-bond and
3990 ! side-chain vectors.
3992 ! implicit real*8 (a-h,o-z)
3993 ! include 'DIMENSIONS'
3994 ! include 'COMMON.GEO'
3995 ! include 'COMMON.VAR'
3996 ! include 'COMMON.LOCAL'
3997 ! include 'COMMON.CHAIN'
3998 ! include 'COMMON.DERIV'
3999 ! include 'COMMON.INTERACT'
4000 ! include 'COMMON.FFIELD'
4001 ! include 'COMMON.IOUNITS'
4002 ! include 'COMMON.CONTROL'
4003 real(kind=8),dimension(3) :: ggg
4005 integer :: i,iint,j,k,iteli,itypj,subchap
4006 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
4008 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
4009 dist_temp, dist_init
4010 integer xshift,yshift,zshift
4014 !d print '(a)','Enter ESCP'
4015 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4016 do i=iatscp_s,iatscp_e
4017 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4019 xi=0.5D0*(c(1,i)+c(1,i+1))
4020 yi=0.5D0*(c(2,i)+c(2,i+1))
4021 zi=0.5D0*(c(3,i)+c(3,i+1))
4023 if (xi.lt.0) xi=xi+boxxsize
4025 if (yi.lt.0) yi=yi+boxysize
4027 if (zi.lt.0) zi=zi+boxzsize
4029 do iint=1,nscp_gr(i)
4031 do j=iscpstart(i,iint),iscpend(i,iint)
4032 itypj=iabs(itype(j))
4033 if (itypj.eq.ntyp1) cycle
4034 ! Uncomment following three lines for SC-p interactions
4038 ! Uncomment following three lines for Ca-p interactions
4046 if (xj.lt.0) xj=xj+boxxsize
4048 if (yj.lt.0) yj=yj+boxysize
4050 if (zj.lt.0) zj=zj+boxzsize
4051 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4059 xj=xj_safe+xshift*boxxsize
4060 yj=yj_safe+yshift*boxysize
4061 zj=zj_safe+zshift*boxzsize
4062 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4063 if(dist_temp.lt.dist_init) then
4073 if (subchap.eq.1) then
4083 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4084 rij=dsqrt(1.0d0/rrij)
4085 sss_ele_cut=sscale_ele(rij)
4086 sss_ele_grad=sscagrad_ele(rij)
4087 ! print *,sss_ele_cut,sss_ele_grad,&
4088 ! (rij),r_cut_ele,rlamb_ele
4089 if (sss_ele_cut.le.0.0) cycle
4091 e1=fac*fac*aad(itypj,iteli)
4092 e2=fac*bad(itypj,iteli)
4093 if (iabs(j-i) .le. 2) then
4096 evdw2_14=evdw2_14+(e1+e2)*sss_ele_cut
4099 evdw2=evdw2+evdwij*sss_ele_cut
4100 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
4101 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
4102 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4105 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
4107 fac=-(evdwij+e1)*rrij*sss_ele_cut
4108 fac=fac+evdwij*sss_ele_grad/rij/expon
4112 !grad if (j.lt.i) then
4113 !d write (iout,*) 'j<i'
4114 ! Uncomment following three lines for SC-p interactions
4116 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4119 !d write (iout,*) 'j>i'
4121 !grad ggg(k)=-ggg(k)
4122 ! Uncomment following line for SC-p interactions
4123 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4124 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4128 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4130 !grad kstart=min0(i+1,j)
4131 !grad kend=max0(i-1,j-1)
4132 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4133 !d write (iout,*) ggg(1),ggg(2),ggg(3)
4134 !grad do k=kstart,kend
4136 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4140 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4141 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4149 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4150 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4151 gradx_scp(j,i)=expon*gradx_scp(j,i)
4154 !******************************************************************************
4158 ! To save time the factor EXPON has been extracted from ALL components
4159 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
4162 !******************************************************************************
4165 !-----------------------------------------------------------------------------
4166 subroutine edis(ehpb)
4168 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4170 ! implicit real*8 (a-h,o-z)
4171 ! include 'DIMENSIONS'
4172 ! include 'COMMON.SBRIDGE'
4173 ! include 'COMMON.CHAIN'
4174 ! include 'COMMON.DERIV'
4175 ! include 'COMMON.VAR'
4176 ! include 'COMMON.INTERACT'
4177 ! include 'COMMON.IOUNITS'
4178 real(kind=8),dimension(3) :: ggg
4180 integer :: i,j,ii,jj,iii,jjj,k
4181 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
4184 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4185 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
4186 if (link_end.eq.0) return
4187 do i=link_start,link_end
4188 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4189 ! CA-CA distance used in regularization of structure.
4192 ! iii and jjj point to the residues for which the distance is assigned.
4193 if (ii.gt.nres) then
4200 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4201 ! & dhpb(i),dhpb1(i),forcon(i)
4202 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
4203 ! distance and angle dependent SS bond potential.
4204 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4205 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4206 if (.not.dyn_ss .and. i.le.nss) then
4207 ! 15/02/13 CC dynamic SSbond - additional check
4208 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. &
4209 iabs(itype(jjj)).eq.1) then
4210 call ssbond_ene(iii,jjj,eij)
4212 !d write (iout,*) "eij",eij
4215 ! Calculate the distance between the two points and its difference from the
4219 ! Get the force constant corresponding to this distance.
4221 ! Calculate the contribution to energy.
4222 ehpb=ehpb+waga*rdis*rdis
4224 ! Evaluate gradient.
4227 !d print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4228 !d & ' waga=',waga,' fac=',fac
4230 ggg(j)=fac*(c(j,jj)-c(j,ii))
4232 !d print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4233 ! If this is a SC-SC distance, we need to calculate the contributions to the
4234 ! Cartesian gradient in the SC vectors (ghpbx).
4237 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4238 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4241 !grad do j=iii,jjj-1
4243 !grad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4247 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4248 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4255 !-----------------------------------------------------------------------------
4256 subroutine ssbond_ene(i,j,eij)
4258 ! Calculate the distance and angle dependent SS-bond potential energy
4259 ! using a free-energy function derived based on RHF/6-31G** ab initio
4260 ! calculations of diethyl disulfide.
4262 ! A. Liwo and U. Kozlowska, 11/24/03
4264 ! implicit real*8 (a-h,o-z)
4265 ! include 'DIMENSIONS'
4266 ! include 'COMMON.SBRIDGE'
4267 ! include 'COMMON.CHAIN'
4268 ! include 'COMMON.DERIV'
4269 ! include 'COMMON.LOCAL'
4270 ! include 'COMMON.INTERACT'
4271 ! include 'COMMON.VAR'
4272 ! include 'COMMON.IOUNITS'
4273 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
4275 integer :: i,j,itypi,itypj,k
4276 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
4277 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
4278 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
4281 itypi=iabs(itype(i))
4285 dxi=dc_norm(1,nres+i)
4286 dyi=dc_norm(2,nres+i)
4287 dzi=dc_norm(3,nres+i)
4288 ! dsci_inv=dsc_inv(itypi)
4289 dsci_inv=vbld_inv(nres+i)
4290 itypj=iabs(itype(j))
4291 ! dscj_inv=dsc_inv(itypj)
4292 dscj_inv=vbld_inv(nres+j)
4296 dxj=dc_norm(1,nres+j)
4297 dyj=dc_norm(2,nres+j)
4298 dzj=dc_norm(3,nres+j)
4299 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4304 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4305 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4306 om12=dxi*dxj+dyi*dyj+dzi*dzj
4308 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4309 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4315 deltat12=om2-om1+2.0d0
4317 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
4318 +akct*deltad*deltat12 &
4319 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4320 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4321 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4322 ! & " deltat12",deltat12," eij",eij
4323 ed=2*akcm*deltad+akct*deltat12
4325 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4326 eom1=-2*akth*deltat1-pom1-om2*pom2
4327 eom2= 2*akth*deltat2+pom1-om1*pom2
4330 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4331 ghpbx(k,i)=ghpbx(k,i)-ggk &
4332 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
4333 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4334 ghpbx(k,j)=ghpbx(k,j)+ggk &
4335 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
4336 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4337 ghpbc(k,i)=ghpbc(k,i)-ggk
4338 ghpbc(k,j)=ghpbc(k,j)+ggk
4341 ! Calculate the components of the gradient in DC and X
4345 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4349 end subroutine ssbond_ene
4350 !-----------------------------------------------------------------------------
4351 subroutine ebond(estr)
4353 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4355 ! implicit real*8 (a-h,o-z)
4356 ! include 'DIMENSIONS'
4357 ! include 'COMMON.LOCAL'
4358 ! include 'COMMON.GEO'
4359 ! include 'COMMON.INTERACT'
4360 ! include 'COMMON.DERIV'
4361 ! include 'COMMON.VAR'
4362 ! include 'COMMON.CHAIN'
4363 ! include 'COMMON.IOUNITS'
4364 ! include 'COMMON.NAMES'
4365 ! include 'COMMON.FFIELD'
4366 ! include 'COMMON.CONTROL'
4367 ! include 'COMMON.SETUP'
4368 real(kind=8),dimension(3) :: u,ud
4370 integer :: i,j,iti,nbi,k
4371 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
4376 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
4377 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
4379 do i=ibondp_start,ibondp_end
4380 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4381 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4382 !C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4384 !C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
4385 !C *dc(j,i-1)/vbld(i)
4387 !C if (energy_dec) write(iout,*) &
4388 !C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4389 diff = vbld(i)-vbldpDUM
4391 diff = vbld(i)-vbldp0
4393 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
4394 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4397 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4399 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4402 estr=0.5d0*AKP*estr+estr1
4404 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4406 do i=ibond_start,ibond_end
4408 if (iti.ne.10 .and. iti.ne.ntyp1) then
4411 diff=vbld(i+nres)-vbldsc0(1,iti)
4412 if (energy_dec) write (iout,*) &
4413 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
4414 AKSC(1,iti),AKSC(1,iti)*diff*diff
4415 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4417 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4421 diff=vbld(i+nres)-vbldsc0(j,iti)
4422 ud(j)=aksc(j,iti)*diff
4423 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4437 uprod2=uprod2*u(k)*u(k)
4441 usumsqder=usumsqder+ud(j)*uprod2
4443 estr=estr+uprod/usum
4445 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4451 end subroutine ebond
4453 !-----------------------------------------------------------------------------
4454 subroutine ebend(etheta)
4456 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4457 ! angles gamma and its derivatives in consecutive thetas and gammas.
4460 ! implicit real*8 (a-h,o-z)
4461 ! include 'DIMENSIONS'
4462 ! include 'COMMON.LOCAL'
4463 ! include 'COMMON.GEO'
4464 ! include 'COMMON.INTERACT'
4465 ! include 'COMMON.DERIV'
4466 ! include 'COMMON.VAR'
4467 ! include 'COMMON.CHAIN'
4468 ! include 'COMMON.IOUNITS'
4469 ! include 'COMMON.NAMES'
4470 ! include 'COMMON.FFIELD'
4471 ! include 'COMMON.CONTROL'
4472 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
4473 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4474 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
4476 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
4477 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4478 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4480 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
4482 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
4483 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
4484 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
4485 real(kind=8),dimension(2) :: y,z
4488 ! time11=dexp(-2*time)
4491 ! write (*,'(a,i2)') 'EBEND ICG=',icg
4492 do i=ithet_start,ithet_end
4493 if (itype(i-1).eq.ntyp1) cycle
4494 ! Zero the energy function and its derivative at 0 or pi.
4495 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4497 ichir1=isign(1,itype(i-2))
4498 ichir2=isign(1,itype(i))
4499 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4500 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4501 if (itype(i-1).eq.10) then
4502 itype1=isign(10,itype(i-2))
4503 ichir11=isign(1,itype(i-2))
4504 ichir12=isign(1,itype(i-2))
4505 itype2=isign(10,itype(i))
4506 ichir21=isign(1,itype(i))
4507 ichir22=isign(1,itype(i))
4510 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4513 if (phii.ne.phii) phii=150.0
4523 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4526 if (phii1.ne.phii1) phii1=150.0
4538 ! Calculate the "mean" value of theta from the part of the distribution
4539 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4540 ! In following comments this theta will be referred to as t_c.
4541 thet_pred_mean=0.0d0
4543 athetk=athet(k,it,ichir1,ichir2)
4544 bthetk=bthet(k,it,ichir1,ichir2)
4546 athetk=athet(k,itype1,ichir11,ichir12)
4547 bthetk=bthet(k,itype2,ichir21,ichir22)
4549 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4551 dthett=thet_pred_mean*ssd
4552 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4553 ! Derivatives of the "mean" values in gamma1 and gamma2.
4554 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
4555 +athet(2,it,ichir1,ichir2)*y(1))*ss
4556 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
4557 +bthet(2,it,ichir1,ichir2)*z(1))*ss
4559 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
4560 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
4561 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
4562 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4564 if (theta(i).gt.pi-delta) then
4565 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
4567 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4568 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4569 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
4571 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
4573 else if (theta(i).lt.delta) then
4574 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4575 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4576 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
4578 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4579 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
4582 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
4585 etheta=etheta+ethetai
4586 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
4588 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4589 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4590 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4592 ! Ufff.... We've done all this!!!
4594 end subroutine ebend
4595 !-----------------------------------------------------------------------------
4596 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
4599 ! implicit real*8 (a-h,o-z)
4600 ! include 'DIMENSIONS'
4601 ! include 'COMMON.LOCAL'
4602 ! include 'COMMON.IOUNITS'
4603 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
4604 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4605 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
4607 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
4609 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
4610 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
4611 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4613 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
4614 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
4616 ! Calculate the contributions to both Gaussian lobes.
4617 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4618 ! The "polynomial part" of the "standard deviation" of this part of
4622 sig=sig*thet_pred_mean+polthet(j,it)
4624 ! Derivative of the "interior part" of the "standard deviation of the"
4625 ! gamma-dependent Gaussian lobe in t_c.
4626 sigtc=3*polthet(3,it)
4628 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4631 ! Set the parameters of both Gaussian lobes of the distribution.
4632 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4633 fac=sig*sig+sigc0(it)
4636 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4637 sigsqtc=-4.0D0*sigcsq*sigtc
4638 ! print *,i,sig,sigtc,sigsqtc
4639 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
4640 sigtc=-sigtc/(fac*fac)
4641 ! Following variable is sigma(t_c)**(-2)
4642 sigcsq=sigcsq*sigcsq
4644 sig0inv=1.0D0/sig0i**2
4645 delthec=thetai-thet_pred_mean
4646 delthe0=thetai-theta0i
4647 term1=-0.5D0*sigcsq*delthec*delthec
4648 term2=-0.5D0*sig0inv*delthe0*delthe0
4649 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4650 ! NaNs in taking the logarithm. We extract the largest exponent which is added
4651 ! to the energy (this being the log of the distribution) at the end of energy
4652 ! term evaluation for this virtual-bond angle.
4653 if (term1.gt.term2) then
4655 term2=dexp(term2-termm)
4659 term1=dexp(term1-termm)
4662 ! The ratio between the gamma-independent and gamma-dependent lobes of
4663 ! the distribution is a Gaussian function of thet_pred_mean too.
4664 diffak=gthet(2,it)-thet_pred_mean
4665 ratak=diffak/gthet(3,it)**2
4666 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4667 ! Let's differentiate it in thet_pred_mean NOW.
4669 ! Now put together the distribution terms to make complete distribution.
4670 termexp=term1+ak*term2
4671 termpre=sigc+ak*sig0i
4672 ! Contribution of the bending energy from this theta is just the -log of
4673 ! the sum of the contributions from the two lobes and the pre-exponential
4674 ! factor. Simple enough, isn't it?
4675 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4676 ! NOW the derivatives!!!
4677 ! 6/6/97 Take into account the deformation.
4678 E_theta=(delthec*sigcsq*term1 &
4679 +ak*delthe0*sig0inv*term2)/termexp
4680 E_tc=((sigtc+aktc*sig0i)/termpre &
4681 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
4682 aktc*term2)/termexp)
4684 end subroutine theteng
4686 !-----------------------------------------------------------------------------
4687 subroutine ebend(etheta)
4689 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4690 ! angles gamma and its derivatives in consecutive thetas and gammas.
4691 ! ab initio-derived potentials from
4692 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4694 ! implicit real*8 (a-h,o-z)
4695 ! include 'DIMENSIONS'
4696 ! include 'COMMON.LOCAL'
4697 ! include 'COMMON.GEO'
4698 ! include 'COMMON.INTERACT'
4699 ! include 'COMMON.DERIV'
4700 ! include 'COMMON.VAR'
4701 ! include 'COMMON.CHAIN'
4702 ! include 'COMMON.IOUNITS'
4703 ! include 'COMMON.NAMES'
4704 ! include 'COMMON.FFIELD'
4705 ! include 'COMMON.CONTROL'
4706 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
4707 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
4708 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
4709 logical :: lprn=.false., lprn1=.false.
4711 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
4712 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
4713 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl
4716 do i=ithet_start,ithet_end
4717 if (itype(i-1).eq.ntyp1) cycle
4718 if (itype(i-2).eq.ntyp1.or.itype(i).eq.ntyp1) cycle
4719 if (iabs(itype(i+1)).eq.20) iblock=2
4720 if (iabs(itype(i+1)).ne.20) iblock=1
4724 theti2=0.5d0*theta(i)
4725 ityp2=ithetyp((itype(i-1)))
4727 coskt(k)=dcos(k*theti2)
4728 sinkt(k)=dsin(k*theti2)
4730 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4733 if (phii.ne.phii) phii=150.0
4737 ityp1=ithetyp((itype(i-2)))
4738 ! propagation of chirality for glycine type
4740 cosph1(k)=dcos(k*phii)
4741 sinph1(k)=dsin(k*phii)
4745 ityp1=ithetyp(itype(i-2))
4751 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4754 if (phii1.ne.phii1) phii1=150.0
4759 ityp3=ithetyp((itype(i)))
4761 cosph2(k)=dcos(k*phii1)
4762 sinph2(k)=dsin(k*phii1)
4766 ityp3=ithetyp(itype(i))
4772 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4775 ccl=cosph1(l)*cosph2(k-l)
4776 ssl=sinph1(l)*sinph2(k-l)
4777 scl=sinph1(l)*cosph2(k-l)
4778 csl=cosph1(l)*sinph2(k-l)
4779 cosph1ph2(l,k)=ccl-ssl
4780 cosph1ph2(k,l)=ccl+ssl
4781 sinph1ph2(l,k)=scl+csl
4782 sinph1ph2(k,l)=scl-csl
4786 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
4787 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4788 write (iout,*) "coskt and sinkt"
4790 write (iout,*) k,coskt(k),sinkt(k)
4794 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4795 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
4798 write (iout,*) "k",k,&
4799 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
4803 write (iout,*) "cosph and sinph"
4805 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4807 write (iout,*) "cosph1ph2 and sinph2ph2"
4810 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
4811 sinph1ph2(l,k),sinph1ph2(k,l)
4814 write(iout,*) "ethetai",ethetai
4818 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
4819 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
4820 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
4821 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4822 ethetai=ethetai+sinkt(m)*aux
4823 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4824 dephii=dephii+k*sinkt(m)* &
4825 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
4826 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4827 dephii1=dephii1+k*sinkt(m)* &
4828 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
4829 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4831 write (iout,*) "m",m," k",k," bbthet", &
4832 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
4833 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
4834 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
4835 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4839 write(iout,*) "ethetai",ethetai
4843 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
4844 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
4845 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
4846 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4847 ethetai=ethetai+sinkt(m)*aux
4848 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4849 dephii=dephii+l*sinkt(m)* &
4850 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
4851 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
4852 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
4853 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4854 dephii1=dephii1+(k-l)*sinkt(m)* &
4855 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
4856 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
4857 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
4858 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4860 write (iout,*) "m",m," k",k," l",l," ffthet",&
4861 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
4862 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
4863 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
4864 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
4866 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
4867 cosph1ph2(k,l)*sinkt(m),&
4868 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4876 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
4877 i,theta(i)*rad2deg,phii*rad2deg,&
4878 phii1*rad2deg,ethetai
4880 etheta=etheta+ethetai
4881 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
4883 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4884 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4885 gloc(nphi+i-2,icg)=wang*dethetai
4888 end subroutine ebend
4891 !-----------------------------------------------------------------------------
4892 subroutine esc(escloc)
4893 ! Calculate the local energy of a side chain and its derivatives in the
4894 ! corresponding virtual-bond valence angles THETA and the spherical angles
4898 ! implicit real*8 (a-h,o-z)
4899 ! include 'DIMENSIONS'
4900 ! include 'COMMON.GEO'
4901 ! include 'COMMON.LOCAL'
4902 ! include 'COMMON.VAR'
4903 ! include 'COMMON.INTERACT'
4904 ! include 'COMMON.DERIV'
4905 ! include 'COMMON.CHAIN'
4906 ! include 'COMMON.IOUNITS'
4907 ! include 'COMMON.NAMES'
4908 ! include 'COMMON.FFIELD'
4909 ! include 'COMMON.CONTROL'
4910 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
4911 ddersc0,ddummy,xtemp,temp
4912 !el real(kind=8) :: time11,time12,time112,theti
4913 real(kind=8) :: escloc,delta
4914 !el integer :: it,nlobit
4915 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
4918 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
4919 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
4922 ! write (iout,'(a)') 'ESC'
4923 do i=loc_start,loc_end
4925 if (it.eq.ntyp1) cycle
4926 if (it.eq.10) goto 1
4927 nlobit=nlob(iabs(it))
4928 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
4929 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4930 theti=theta(i+1)-pipol
4935 if (x(2).gt.pi-delta) then
4939 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4941 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4942 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
4944 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
4945 ddersc0(1),dersc(1))
4946 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
4947 ddersc0(3),dersc(3))
4949 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4951 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4952 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
4953 dersc0(2),esclocbi,dersc02)
4954 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
4956 call splinthet(x(2),0.5d0*delta,ss,ssd)
4961 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4963 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4964 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4966 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4968 ! write (iout,*) escloci
4969 else if (x(2).lt.delta) then
4973 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4975 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4976 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
4978 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
4979 ddersc0(1),dersc(1))
4980 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
4981 ddersc0(3),dersc(3))
4983 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4985 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4986 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
4987 dersc0(2),esclocbi,dersc02)
4988 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
4993 call splinthet(x(2),0.5d0*delta,ss,ssd)
4995 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4997 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4998 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5000 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5001 ! write (iout,*) escloci
5003 call enesc(x,escloci,dersc,ddummy,.false.)
5006 escloc=escloc+escloci
5007 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5009 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5011 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
5013 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5014 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5019 !-----------------------------------------------------------------------------
5020 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5023 ! implicit real*8 (a-h,o-z)
5024 ! include 'DIMENSIONS'
5025 ! include 'COMMON.GEO'
5026 ! include 'COMMON.LOCAL'
5027 ! include 'COMMON.IOUNITS'
5028 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5029 real(kind=8),dimension(3) :: x,z,dersc,ddersc
5030 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
5031 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
5032 real(kind=8) :: escloci
5035 integer :: j,iii,l,k !el,it,nlobit
5036 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
5037 !el time11,time12,time112
5038 ! write (iout,*) 'it=',it,' nlobit=',nlobit
5042 if (mixed) ddersc(j)=0.0d0
5046 ! Because of periodicity of the dependence of the SC energy in omega we have
5047 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5048 ! To avoid underflows, first compute & store the exponents.
5056 z(k)=x(k)-censc(k,j,it)
5061 Axk=Axk+gaussc(l,k,j,it)*z(l)
5067 expfac=expfac+Ax(k,j,iii)*z(k)
5075 ! As in the case of ebend, we want to avoid underflows in exponentiation and
5076 ! subsequent NaNs and INFs in energy calculation.
5077 ! Find the largest exponent
5081 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5085 !d print *,'it=',it,' emin=',emin
5087 ! Compute the contribution to SC energy and derivatives
5092 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5093 if(adexp.ne.adexp) adexp=1.0
5096 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5098 !d print *,'j=',j,' expfac=',expfac
5099 escloc_i=escloc_i+expfac
5101 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5105 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
5106 +gaussc(k,2,j,it))*expfac
5113 dersc(1)=dersc(1)/cos(theti)**2
5114 ddersc(1)=ddersc(1)/cos(theti)**2
5117 escloci=-(dlog(escloc_i)-emin)
5119 dersc(j)=dersc(j)/escloc_i
5123 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5127 end subroutine enesc
5128 !-----------------------------------------------------------------------------
5129 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5132 ! implicit real*8 (a-h,o-z)
5133 ! include 'DIMENSIONS'
5134 ! include 'COMMON.GEO'
5135 ! include 'COMMON.LOCAL'
5136 ! include 'COMMON.IOUNITS'
5137 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5138 real(kind=8),dimension(3) :: x,z,dersc
5139 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
5140 real(kind=8),dimension(nlobit) :: contr !(maxlob)
5141 real(kind=8) :: escloci,dersc12,emin
5144 integer :: j,k,l !el,it,nlobit
5145 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
5155 z(k)=x(k)-censc(k,j,it)
5161 Axk=Axk+gaussc(l,k,j,it)*z(l)
5167 expfac=expfac+Ax(k,j)*z(k)
5172 ! As in the case of ebend, we want to avoid underflows in exponentiation and
5173 ! subsequent NaNs and INFs in energy calculation.
5174 ! Find the largest exponent
5177 if (emin.gt.contr(j)) emin=contr(j)
5181 ! Compute the contribution to SC energy and derivatives
5185 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5186 escloc_i=escloc_i+expfac
5188 dersc(k)=dersc(k)+Ax(k,j)*expfac
5190 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
5191 +gaussc(1,2,j,it))*expfac
5195 dersc(1)=dersc(1)/cos(theti)**2
5196 dersc12=dersc12/cos(theti)**2
5197 escloci=-(dlog(escloc_i)-emin)
5199 dersc(j)=dersc(j)/escloc_i
5201 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5203 end subroutine enesc_bound
5205 !-----------------------------------------------------------------------------
5206 subroutine esc(escloc)
5207 ! Calculate the local energy of a side chain and its derivatives in the
5208 ! corresponding virtual-bond valence angles THETA and the spherical angles
5209 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
5210 ! added by Urszula Kozlowska. 07/11/2007
5213 ! implicit real*8 (a-h,o-z)
5214 ! include 'DIMENSIONS'
5215 ! include 'COMMON.GEO'
5216 ! include 'COMMON.LOCAL'
5217 ! include 'COMMON.VAR'
5218 ! include 'COMMON.SCROT'
5219 ! include 'COMMON.INTERACT'
5220 ! include 'COMMON.DERIV'
5221 ! include 'COMMON.CHAIN'
5222 ! include 'COMMON.IOUNITS'
5223 ! include 'COMMON.NAMES'
5224 ! include 'COMMON.FFIELD'
5225 ! include 'COMMON.CONTROL'
5226 ! include 'COMMON.VECTORS'
5227 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
5228 real(kind=8),dimension(65) :: x
5229 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
5230 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
5231 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
5232 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
5233 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
5235 integer :: i,j,k !el,it,nlobit
5236 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
5237 !el real(kind=8) :: time11,time12,time112,theti
5238 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5239 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
5240 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
5241 sumene1x,sumene2x,sumene3x,sumene4x,&
5242 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
5245 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
5246 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
5249 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
5253 do i=loc_start,loc_end
5254 if (itype(i).eq.ntyp1) cycle
5255 costtab(i+1) =dcos(theta(i+1))
5256 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5257 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5258 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5259 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5260 cosfac=dsqrt(cosfac2)
5261 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5262 sinfac=dsqrt(sinfac2)
5264 if (it.eq.10) goto 1
5266 ! Compute the axes of tghe local cartesian coordinates system; store in
5267 ! x_prime, y_prime and z_prime
5274 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5275 ! & dc_norm(3,i+nres)
5277 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5278 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5281 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5284 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
5285 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
5286 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
5287 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5288 ! & " xy",scalar(x_prime(1),y_prime(1)),
5289 ! & " xz",scalar(x_prime(1),z_prime(1)),
5290 ! & " yy",scalar(y_prime(1),y_prime(1)),
5291 ! & " yz",scalar(y_prime(1),z_prime(1)),
5292 ! & " zz",scalar(z_prime(1),z_prime(1))
5294 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5295 ! to local coordinate system. Store in xx, yy, zz.
5301 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5302 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5303 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5310 ! Compute the energy of the ith side cbain
5312 ! write (2,*) "xx",xx," yy",yy," zz",zz
5315 x(j) = sc_parmin(j,it)
5318 !c diagnostics - remove later
5320 yy1 = dsin(alph(2))*dcos(omeg(2))
5321 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5322 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
5323 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
5325 !," --- ", xx_w,yy_w,zz_w
5328 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
5329 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
5331 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
5332 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
5334 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
5335 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
5336 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
5337 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
5338 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
5340 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
5341 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
5342 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
5343 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
5344 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
5346 dsc_i = 0.743d0+x(61)
5348 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5349 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5350 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5351 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5352 s1=(1+x(63))/(0.1d0 + dscp1)
5353 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5354 s2=(1+x(65))/(0.1d0 + dscp2)
5355 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5356 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
5357 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5358 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5360 ! & dscp1,dscp2,sumene
5361 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5362 escloc = escloc + sumene
5363 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5368 ! This section to check the numerical derivatives of the energy of ith side
5369 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5370 ! #define DEBUG in the code to turn it on.
5372 write (2,*) "sumene =",sumene
5376 write (2,*) xx,yy,zz
5377 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5378 de_dxx_num=(sumenep-sumene)/aincr
5380 write (2,*) "xx+ sumene from enesc=",sumenep
5383 write (2,*) xx,yy,zz
5384 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5385 de_dyy_num=(sumenep-sumene)/aincr
5387 write (2,*) "yy+ sumene from enesc=",sumenep
5390 write (2,*) xx,yy,zz
5391 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5392 de_dzz_num=(sumenep-sumene)/aincr
5394 write (2,*) "zz+ sumene from enesc=",sumenep
5395 costsave=cost2tab(i+1)
5396 sintsave=sint2tab(i+1)
5397 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5398 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5399 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5400 de_dt_num=(sumenep-sumene)/aincr
5401 write (2,*) " t+ sumene from enesc=",sumenep
5402 cost2tab(i+1)=costsave
5403 sint2tab(i+1)=sintsave
5404 ! End of diagnostics section.
5407 ! Compute the gradient of esc
5409 ! zz=zz*dsign(1.0,dfloat(itype(i)))
5410 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5411 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5412 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5413 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5414 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5415 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5416 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5417 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5418 pom1=(sumene3*sint2tab(i+1)+sumene1) &
5419 *(pom_s1/dscp1+pom_s16*dscp1**4)
5420 pom2=(sumene4*cost2tab(i+1)+sumene2) &
5421 *(pom_s2/dscp2+pom_s26*dscp2**4)
5422 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5423 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
5424 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
5426 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5427 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
5428 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
5430 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
5431 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
5434 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5437 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5438 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
5439 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
5441 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5442 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
5443 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
5444 +x(59)*zz**2 +x(60)*xx*zz
5445 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
5446 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
5449 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5452 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
5453 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
5454 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
5455 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
5456 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
5457 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
5458 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
5459 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5461 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5464 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
5465 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
5466 +pom1*pom_dt1+pom2*pom_dt2
5468 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5472 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5473 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5474 cosfac2xx=cosfac2*xx
5475 sinfac2yy=sinfac2*yy
5477 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
5479 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
5481 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5482 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5483 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5484 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5485 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5486 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5487 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5488 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5489 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5490 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5494 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
5495 *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5496 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
5497 *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5500 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5501 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5502 dZZ_XYZ(k)=vbld_inv(i+nres)* &
5503 (z_prime(k)-zz*dC_norm(k,i+nres))
5505 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5506 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5510 dXX_Ctab(k,i)=dXX_Ci(k)
5511 dXX_C1tab(k,i)=dXX_Ci1(k)
5512 dYY_Ctab(k,i)=dYY_Ci(k)
5513 dYY_C1tab(k,i)=dYY_Ci1(k)
5514 dZZ_Ctab(k,i)=dZZ_Ci(k)
5515 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5516 dXX_XYZtab(k,i)=dXX_XYZ(k)
5517 dYY_XYZtab(k,i)=dYY_XYZ(k)
5518 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5522 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5523 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5524 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5525 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
5526 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5528 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5529 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5530 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
5531 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5532 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
5533 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5534 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
5535 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5537 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5538 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5540 ! to check gradient call subroutine check_grad
5546 !-----------------------------------------------------------------------------
5547 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
5549 real(kind=8),dimension(65) :: x
5550 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
5551 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5553 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
5554 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
5556 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
5557 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
5559 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
5560 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
5561 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
5562 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
5563 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
5565 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
5566 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
5567 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
5568 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
5569 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
5571 dsc_i = 0.743d0+x(61)
5573 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5574 *(xx*cost2+yy*sint2))
5575 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5576 *(xx*cost2-yy*sint2))
5577 s1=(1+x(63))/(0.1d0 + dscp1)
5578 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5579 s2=(1+x(65))/(0.1d0 + dscp2)
5580 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5581 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
5582 + (sumene4*cost2 +sumene2)*(s2+s2_6)
5587 !-----------------------------------------------------------------------------
5588 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5590 ! This procedure calculates two-body contact function g(rij) and its derivative:
5593 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5596 ! where x=(rij-r0ij)/delta
5598 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5601 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
5602 real(kind=8) :: x,x2,x4,delta
5606 if (x.lt.-1.0D0) then
5609 else if (x.le.1.0D0) then
5612 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5613 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5619 end subroutine gcont
5620 !-----------------------------------------------------------------------------
5621 subroutine splinthet(theti,delta,ss,ssder)
5622 ! implicit real*8 (a-h,o-z)
5623 ! include 'DIMENSIONS'
5624 ! include 'COMMON.VAR'
5625 ! include 'COMMON.GEO'
5626 real(kind=8) :: theti,delta,ss,ssder
5627 real(kind=8) :: thetup,thetlow
5630 if (theti.gt.pipol) then
5631 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5633 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5637 end subroutine splinthet
5638 !-----------------------------------------------------------------------------
5639 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5641 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
5642 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
5643 a1=fprim0*delta/(f1-f0)
5649 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5650 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5652 end subroutine spline1
5653 !-----------------------------------------------------------------------------
5654 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5656 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
5657 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
5662 a2=3*(f1x-f0x)-2*fprim0x*delta
5663 a3=fprim0x*delta-2*(f1x-f0x)
5664 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5666 end subroutine spline2
5667 !-----------------------------------------------------------------------------
5669 !-----------------------------------------------------------------------------
5670 subroutine etor(etors,edihcnstr)
5671 ! implicit real*8 (a-h,o-z)
5672 ! include 'DIMENSIONS'
5673 ! include 'COMMON.VAR'
5674 ! include 'COMMON.GEO'
5675 ! include 'COMMON.LOCAL'
5676 ! include 'COMMON.TORSION'
5677 ! include 'COMMON.INTERACT'
5678 ! include 'COMMON.DERIV'
5679 ! include 'COMMON.CHAIN'
5680 ! include 'COMMON.NAMES'
5681 ! include 'COMMON.IOUNITS'
5682 ! include 'COMMON.FFIELD'
5683 ! include 'COMMON.TORCNSTR'
5684 ! include 'COMMON.CONTROL'
5685 real(kind=8) :: etors,edihcnstr
5689 real(kind=8) :: phii,fac,etors_ii
5691 ! Set lprn=.true. for debugging
5695 do i=iphi_start,iphi_end
5697 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 &
5698 .or. itype(i).eq.ntyp1) cycle
5699 itori=itortyp(itype(i-2))
5700 itori1=itortyp(itype(i-1))
5703 ! Proline-Proline pair is a special case...
5704 if (itori.eq.3 .and. itori1.eq.3) then
5705 if (phii.gt.-dwapi3) then
5707 fac=1.0D0/(1.0D0-cosphi)
5708 etorsi=v1(1,3,3)*fac
5709 etorsi=etorsi+etorsi
5710 etors=etors+etorsi-v1(1,3,3)
5711 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5712 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5715 v1ij=v1(j+1,itori,itori1)
5716 v2ij=v2(j+1,itori,itori1)
5719 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5720 if (energy_dec) etors_ii=etors_ii+ &
5721 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5722 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5726 v1ij=v1(j,itori,itori1)
5727 v2ij=v2(j,itori,itori1)
5730 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5731 if (energy_dec) etors_ii=etors_ii+ &
5732 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5733 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5736 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5739 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5740 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
5741 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5742 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5743 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5745 ! 6/20/98 - dihedral angle constraints
5748 itori=idih_constr(i)
5751 if (difi.gt.drange(i)) then
5753 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5754 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5755 else if (difi.lt.-drange(i)) then
5757 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5758 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5760 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5761 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5763 ! write (iout,*) 'edihcnstr',edihcnstr
5766 !-----------------------------------------------------------------------------
5767 subroutine etor_d(etors_d)
5768 real(kind=8) :: etors_d
5771 end subroutine etor_d
5773 !-----------------------------------------------------------------------------
5774 subroutine etor(etors,edihcnstr)
5775 ! implicit real*8 (a-h,o-z)
5776 ! include 'DIMENSIONS'
5777 ! include 'COMMON.VAR'
5778 ! include 'COMMON.GEO'
5779 ! include 'COMMON.LOCAL'
5780 ! include 'COMMON.TORSION'
5781 ! include 'COMMON.INTERACT'
5782 ! include 'COMMON.DERIV'
5783 ! include 'COMMON.CHAIN'
5784 ! include 'COMMON.NAMES'
5785 ! include 'COMMON.IOUNITS'
5786 ! include 'COMMON.FFIELD'
5787 ! include 'COMMON.TORCNSTR'
5788 ! include 'COMMON.CONTROL'
5789 real(kind=8) :: etors,edihcnstr
5792 integer :: i,j,iblock,itori,itori1
5793 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
5794 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
5795 ! Set lprn=.true. for debugging
5799 do i=iphi_start,iphi_end
5800 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
5801 .or. itype(i-3).eq.ntyp1 &
5802 .or. itype(i).eq.ntyp1) cycle
5804 if (iabs(itype(i)).eq.20) then
5809 itori=itortyp(itype(i-2))
5810 itori1=itortyp(itype(i-1))
5813 ! Regular cosine and sine terms
5814 do j=1,nterm(itori,itori1,iblock)
5815 v1ij=v1(j,itori,itori1,iblock)
5816 v2ij=v2(j,itori,itori1,iblock)
5819 etors=etors+v1ij*cosphi+v2ij*sinphi
5820 if (energy_dec) etors_ii=etors_ii+ &
5821 v1ij*cosphi+v2ij*sinphi
5822 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5826 ! E = SUM ----------------------------------- - v1
5827 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5829 cosphi=dcos(0.5d0*phii)
5830 sinphi=dsin(0.5d0*phii)
5831 do j=1,nlor(itori,itori1,iblock)
5832 vl1ij=vlor1(j,itori,itori1)
5833 vl2ij=vlor2(j,itori,itori1)
5834 vl3ij=vlor3(j,itori,itori1)
5835 pom=vl2ij*cosphi+vl3ij*sinphi
5836 pom1=1.0d0/(pom*pom+1.0d0)
5837 etors=etors+vl1ij*pom1
5838 if (energy_dec) etors_ii=etors_ii+ &
5841 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5843 ! Subtract the constant term
5844 etors=etors-v0(itori,itori1,iblock)
5845 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5846 'etor',i,etors_ii-v0(itori,itori1,iblock)
5848 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
5849 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
5850 (v1(j,itori,itori1,iblock),j=1,6),&
5851 (v2(j,itori,itori1,iblock),j=1,6)
5852 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5853 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5855 ! 6/20/98 - dihedral angle constraints
5857 ! do i=1,ndih_constr
5858 do i=idihconstr_start,idihconstr_end
5859 itori=idih_constr(i)
5861 difi=pinorm(phii-phi0(i))
5862 if (difi.gt.drange(i)) then
5864 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5865 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5866 else if (difi.lt.-drange(i)) then
5868 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5869 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5873 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5874 !d & rad2deg*phi0(i), rad2deg*drange(i),
5875 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5877 !d write (iout,*) 'edihcnstr',edihcnstr
5880 !-----------------------------------------------------------------------------
5881 subroutine etor_d(etors_d)
5882 ! 6/23/01 Compute double torsional energy
5883 ! implicit real*8 (a-h,o-z)
5884 ! include 'DIMENSIONS'
5885 ! include 'COMMON.VAR'
5886 ! include 'COMMON.GEO'
5887 ! include 'COMMON.LOCAL'
5888 ! include 'COMMON.TORSION'
5889 ! include 'COMMON.INTERACT'
5890 ! include 'COMMON.DERIV'
5891 ! include 'COMMON.CHAIN'
5892 ! include 'COMMON.NAMES'
5893 ! include 'COMMON.IOUNITS'
5894 ! include 'COMMON.FFIELD'
5895 ! include 'COMMON.TORCNSTR'
5896 real(kind=8) :: etors_d,etors_d_ii
5899 integer :: i,j,k,l,itori,itori1,itori2,iblock
5900 real(kind=8) :: phii,phii1,gloci1,gloci2,&
5901 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
5902 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
5903 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
5904 ! Set lprn=.true. for debugging
5908 ! write(iout,*) "a tu??"
5909 do i=iphid_start,iphid_end
5911 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
5912 .or. itype(i-3).eq.ntyp1 &
5913 .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5914 itori=itortyp(itype(i-2))
5915 itori1=itortyp(itype(i-1))
5916 itori2=itortyp(itype(i))
5922 if (iabs(itype(i+1)).eq.20) iblock=2
5924 ! Regular cosine and sine terms
5925 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5926 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5927 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5928 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5929 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5930 cosphi1=dcos(j*phii)
5931 sinphi1=dsin(j*phii)
5932 cosphi2=dcos(j*phii1)
5933 sinphi2=dsin(j*phii1)
5934 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
5935 v2cij*cosphi2+v2sij*sinphi2
5936 if (energy_dec) etors_d_ii=etors_d_ii+ &
5937 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
5938 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5939 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5941 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5943 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5944 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5945 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5946 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5947 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5948 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5949 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5950 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5951 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
5952 v1sdij*sinphi1p2+v2sdij*sinphi1m2
5953 if (energy_dec) etors_d_ii=etors_d_ii+ &
5954 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
5955 v1sdij*sinphi1p2+v2sdij*sinphi1m2
5956 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
5957 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5958 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
5959 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5962 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5963 'etor_d',i,etors_d_ii
5964 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5965 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5968 end subroutine etor_d
5970 !-----------------------------------------------------------------------------
5971 subroutine eback_sc_corr(esccor)
5972 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
5973 ! conformational states; temporarily implemented as differences
5974 ! between UNRES torsional potentials (dependent on three types of
5975 ! residues) and the torsional potentials dependent on all 20 types
5976 ! of residues computed from AM1 energy surfaces of terminally-blocked
5977 ! amino-acid residues.
5978 ! implicit real*8 (a-h,o-z)
5979 ! include 'DIMENSIONS'
5980 ! include 'COMMON.VAR'
5981 ! include 'COMMON.GEO'
5982 ! include 'COMMON.LOCAL'
5983 ! include 'COMMON.TORSION'
5984 ! include 'COMMON.SCCOR'
5985 ! include 'COMMON.INTERACT'
5986 ! include 'COMMON.DERIV'
5987 ! include 'COMMON.CHAIN'
5988 ! include 'COMMON.NAMES'
5989 ! include 'COMMON.IOUNITS'
5990 ! include 'COMMON.FFIELD'
5991 ! include 'COMMON.CONTROL'
5992 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
5995 integer :: i,interty,j,isccori,isccori1,intertyp
5996 ! Set lprn=.true. for debugging
5999 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6001 do i=itau_start,itau_end
6002 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6004 isccori=isccortyp(itype(i-2))
6005 isccori1=isccortyp(itype(i-1))
6007 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6009 do intertyp=1,3 !intertyp
6011 !c Added 09 May 2012 (Adasko)
6012 !c Intertyp means interaction type of backbone mainchain correlation:
6013 ! 1 = SC...Ca...Ca...Ca
6014 ! 2 = Ca...Ca...Ca...SC
6015 ! 3 = SC...Ca...Ca...SCi
6017 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. &
6018 (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or. &
6019 (itype(i-1).eq.ntyp1))) &
6020 .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) &
6021 .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1) &
6022 .or.(itype(i).eq.ntyp1))) &
6023 .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. &
6024 (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. &
6025 (itype(i-3).eq.ntyp1)))) cycle
6026 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6027 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1)) &
6029 do j=1,nterm_sccor(isccori,isccori1)
6030 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6031 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6032 cosphi=dcos(j*tauangle(intertyp,i))
6033 sinphi=dsin(j*tauangle(intertyp,i))
6034 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
6035 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6036 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6038 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
6039 'esccor',i,intertyp,esccor_ii
6040 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6041 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6043 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6044 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,&
6045 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
6046 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6047 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6052 end subroutine eback_sc_corr
6053 !-----------------------------------------------------------------------------
6054 subroutine multibody(ecorr)
6055 ! This subroutine calculates multi-body contributions to energy following
6056 ! the idea of Skolnick et al. If side chains I and J make a contact and
6057 ! at the same time side chains I+1 and J+1 make a contact, an extra
6058 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6059 ! implicit real*8 (a-h,o-z)
6060 ! include 'DIMENSIONS'
6061 ! include 'COMMON.IOUNITS'
6062 ! include 'COMMON.DERIV'
6063 ! include 'COMMON.INTERACT'
6064 ! include 'COMMON.CONTACTS'
6065 real(kind=8),dimension(3) :: gx,gx1
6067 real(kind=8) :: ecorr
6068 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
6069 ! Set lprn=.true. for debugging
6073 write (iout,'(a)') 'Contact function values:'
6075 write (iout,'(i2,20(1x,i2,f10.5))') &
6076 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6081 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6082 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6094 num_conti=num_cont(i)
6095 num_conti1=num_cont(i1)
6100 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6101 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6102 !d & ' ishift=',ishift
6103 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6104 ! The system gains extra energy.
6105 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6106 endif ! j1==j+-ishift
6114 end subroutine multibody
6115 !-----------------------------------------------------------------------------
6116 real(kind=8) function esccorr(i,j,k,l,jj,kk)
6117 ! implicit real*8 (a-h,o-z)
6118 ! include 'DIMENSIONS'
6119 ! include 'COMMON.IOUNITS'
6120 ! include 'COMMON.DERIV'
6121 ! include 'COMMON.INTERACT'
6122 ! include 'COMMON.CONTACTS'
6123 real(kind=8),dimension(3) :: gx,gx1
6125 integer :: i,j,k,l,jj,kk,m,ll
6126 real(kind=8) :: eij,ekl
6130 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6131 ! Calculate the multi-body contribution to energy.
6132 ! Calculate multi-body contributions to the gradient.
6133 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6134 !d & k,l,(gacont(m,kk,k),m=1,3)
6136 gx(m) =ekl*gacont(m,jj,i)
6137 gx1(m)=eij*gacont(m,kk,k)
6138 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6139 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6140 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6141 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6145 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6150 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6155 end function esccorr
6156 !-----------------------------------------------------------------------------
6157 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6158 ! This subroutine calculates multi-body contributions to hydrogen-bonding
6159 ! implicit real*8 (a-h,o-z)
6160 ! include 'DIMENSIONS'
6161 ! include 'COMMON.IOUNITS'
6164 ! integer :: maxconts !max_cont=maxconts =nres/4
6165 integer,parameter :: max_dim=26
6166 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6167 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6168 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
6169 !el common /przechowalnia/ zapas
6170 integer :: status(MPI_STATUS_SIZE)
6171 integer,dimension((nres/4)*2) :: req !maxconts*2
6172 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
6174 ! include 'COMMON.SETUP'
6175 ! include 'COMMON.FFIELD'
6176 ! include 'COMMON.DERIV'
6177 ! include 'COMMON.INTERACT'
6178 ! include 'COMMON.CONTACTS'
6179 ! include 'COMMON.CONTROL'
6180 ! include 'COMMON.LOCAL'
6181 real(kind=8),dimension(3) :: gx,gx1
6182 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
6183 logical :: lprn,ldone
6185 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
6186 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
6188 ! Set lprn=.true. for debugging
6192 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
6195 if (nfgtasks.le.1) goto 30
6197 write (iout,'(a)') 'Contact function values before RECEIVE:'
6199 write (iout,'(2i3,50(1x,i2,f5.2))') &
6200 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6205 do i=1,ntask_cont_from
6208 do i=1,ntask_cont_to
6211 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6213 ! Make the list of contacts to send to send to other procesors
6214 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6216 do i=iturn3_start,iturn3_end
6217 ! write (iout,*) "make contact list turn3",i," num_cont",
6219 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6221 do i=iturn4_start,iturn4_end
6222 ! write (iout,*) "make contact list turn4",i," num_cont",
6224 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6228 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
6230 do j=1,num_cont_hb(i)
6233 iproc=iint_sent_local(k,jjc,ii)
6234 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6235 if (iproc.gt.0) then
6236 ncont_sent(iproc)=ncont_sent(iproc)+1
6237 nn=ncont_sent(iproc)
6239 zapas(2,nn,iproc)=jjc
6240 zapas(3,nn,iproc)=facont_hb(j,i)
6241 zapas(4,nn,iproc)=ees0p(j,i)
6242 zapas(5,nn,iproc)=ees0m(j,i)
6243 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6244 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6245 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6246 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6247 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6248 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6249 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6250 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6251 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6252 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6253 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6254 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6255 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6256 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6257 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6258 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6259 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6260 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6261 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6262 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6263 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6270 "Numbers of contacts to be sent to other processors",&
6271 (ncont_sent(i),i=1,ntask_cont_to)
6272 write (iout,*) "Contacts sent"
6273 do ii=1,ntask_cont_to
6275 iproc=itask_cont_to(ii)
6276 write (iout,*) nn," contacts to processor",iproc,&
6277 " of CONT_TO_COMM group"
6279 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6287 CorrelID1=nfgtasks+fg_rank+1
6289 ! Receive the numbers of needed contacts from other processors
6290 do ii=1,ntask_cont_from
6291 iproc=itask_cont_from(ii)
6293 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
6294 FG_COMM,req(ireq),IERR)
6296 ! write (iout,*) "IRECV ended"
6298 ! Send the number of contacts needed by other processors
6299 do ii=1,ntask_cont_to
6300 iproc=itask_cont_to(ii)
6302 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
6303 FG_COMM,req(ireq),IERR)
6305 ! write (iout,*) "ISEND ended"
6306 ! write (iout,*) "number of requests (nn)",ireq
6309 call MPI_Waitall(ireq,req,status_array,ierr)
6311 ! & "Numbers of contacts to be received from other processors",
6312 ! & (ncont_recv(i),i=1,ntask_cont_from)
6316 do ii=1,ntask_cont_from
6317 iproc=itask_cont_from(ii)
6319 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
6320 ! & " of CONT_TO_COMM group"
6324 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
6325 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6326 ! write (iout,*) "ireq,req",ireq,req(ireq)
6329 ! Send the contacts to processors that need them
6330 do ii=1,ntask_cont_to
6331 iproc=itask_cont_to(ii)
6333 ! write (iout,*) nn," contacts to processor",iproc,
6334 ! & " of CONT_TO_COMM group"
6337 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
6338 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6339 ! write (iout,*) "ireq,req",ireq,req(ireq)
6341 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6345 ! write (iout,*) "number of requests (contacts)",ireq
6346 ! write (iout,*) "req",(req(i),i=1,4)
6349 call MPI_Waitall(ireq,req,status_array,ierr)
6350 do iii=1,ntask_cont_from
6351 iproc=itask_cont_from(iii)
6354 write (iout,*) "Received",nn," contacts from processor",iproc,&
6355 " of CONT_FROM_COMM group"
6358 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6363 ii=zapas_recv(1,i,iii)
6364 ! Flag the received contacts to prevent double-counting
6365 jj=-zapas_recv(2,i,iii)
6366 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6368 nnn=num_cont_hb(ii)+1
6371 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6372 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6373 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6374 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6375 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6376 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6377 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6378 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6379 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6380 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6381 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6382 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6383 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6384 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6385 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6386 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6387 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6388 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6389 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6390 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6391 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6392 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6393 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6394 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6399 write (iout,'(a)') 'Contact function values after receive:'
6401 write (iout,'(2i3,50(1x,i3,f5.2))') &
6402 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6410 write (iout,'(a)') 'Contact function values:'
6412 write (iout,'(2i3,50(1x,i3,f5.2))') &
6413 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6419 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6420 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6421 ! Remove the loop below after debugging !!!
6428 ! Calculate the local-electrostatic correlation terms
6429 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6431 num_conti=num_cont_hb(i)
6432 num_conti1=num_cont_hb(i+1)
6439 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
6440 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
6441 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
6442 .or. j.lt.0 .and. j1.gt.0) .and. &
6443 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6444 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6445 ! The system gains extra energy.
6446 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6447 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
6448 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6450 else if (j1.eq.j) then
6451 ! Contacts I-J and I-(J+1) occur simultaneously.
6452 ! The system loses extra energy.
6453 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6458 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6459 ! & ' jj=',jj,' kk=',kk
6461 ! Contacts I-J and (I+1)-J occur simultaneously.
6462 ! The system loses extra energy.
6463 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6469 end subroutine multibody_hb
6470 !-----------------------------------------------------------------------------
6471 subroutine add_hb_contact(ii,jj,itask)
6472 ! implicit real*8 (a-h,o-z)
6473 ! include "DIMENSIONS"
6474 ! include "COMMON.IOUNITS"
6475 ! include "COMMON.CONTACTS"
6476 ! integer,parameter :: maxconts=nres/4
6477 integer,parameter :: max_dim=26
6478 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6479 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
6480 ! common /przechowalnia/ zapas
6481 integer :: i,j,ii,jj,iproc,nn,jjc
6482 integer,dimension(4) :: itask
6483 ! write (iout,*) "itask",itask
6486 if (iproc.gt.0) then
6487 do j=1,num_cont_hb(ii)
6489 ! write (iout,*) "i",ii," j",jj," jjc",jjc
6491 ncont_sent(iproc)=ncont_sent(iproc)+1
6492 nn=ncont_sent(iproc)
6493 zapas(1,nn,iproc)=ii
6494 zapas(2,nn,iproc)=jjc
6495 zapas(3,nn,iproc)=facont_hb(j,ii)
6496 zapas(4,nn,iproc)=ees0p(j,ii)
6497 zapas(5,nn,iproc)=ees0m(j,ii)
6498 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6499 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6500 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6501 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6502 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6503 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6504 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6505 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6506 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6507 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6508 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6509 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6510 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6511 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6512 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6513 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6514 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6515 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6516 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6517 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6518 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6525 end subroutine add_hb_contact
6526 !-----------------------------------------------------------------------------
6527 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
6528 ! This subroutine calculates multi-body contributions to hydrogen-bonding
6529 ! implicit real*8 (a-h,o-z)
6530 ! include 'DIMENSIONS'
6531 ! include 'COMMON.IOUNITS'
6532 integer,parameter :: max_dim=70
6535 ! integer :: maxconts !max_cont=maxconts=nres/4
6536 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6537 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
6538 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6539 ! common /przechowalnia/ zapas
6540 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
6541 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
6544 ! include 'COMMON.SETUP'
6545 ! include 'COMMON.FFIELD'
6546 ! include 'COMMON.DERIV'
6547 ! include 'COMMON.LOCAL'
6548 ! include 'COMMON.INTERACT'
6549 ! include 'COMMON.CONTACTS'
6550 ! include 'COMMON.CHAIN'
6551 ! include 'COMMON.CONTROL'
6552 real(kind=8),dimension(3) :: gx,gx1
6553 integer,dimension(nres) :: num_cont_hb_old
6554 logical :: lprn,ldone
6555 !EL double precision eello4,eello5,eelo6,eello_turn6
6556 !EL external eello4,eello5,eello6,eello_turn6
6558 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
6559 j1,jp1,i1,num_conti1
6560 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
6561 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
6563 ! Set lprn=.true. for debugging
6568 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
6570 num_cont_hb_old(i)=num_cont_hb(i)
6574 if (nfgtasks.le.1) goto 30
6576 write (iout,'(a)') 'Contact function values before RECEIVE:'
6578 write (iout,'(2i3,50(1x,i2,f5.2))') &
6579 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6584 do i=1,ntask_cont_from
6587 do i=1,ntask_cont_to
6590 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6592 ! Make the list of contacts to send to send to other procesors
6593 do i=iturn3_start,iturn3_end
6594 ! write (iout,*) "make contact list turn3",i," num_cont",
6596 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6598 do i=iturn4_start,iturn4_end
6599 ! write (iout,*) "make contact list turn4",i," num_cont",
6601 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6605 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
6607 do j=1,num_cont_hb(i)
6610 iproc=iint_sent_local(k,jjc,ii)
6611 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6612 if (iproc.ne.0) then
6613 ncont_sent(iproc)=ncont_sent(iproc)+1
6614 nn=ncont_sent(iproc)
6616 zapas(2,nn,iproc)=jjc
6617 zapas(3,nn,iproc)=d_cont(j,i)
6621 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6626 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6634 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6645 "Numbers of contacts to be sent to other processors",&
6646 (ncont_sent(i),i=1,ntask_cont_to)
6647 write (iout,*) "Contacts sent"
6648 do ii=1,ntask_cont_to
6650 iproc=itask_cont_to(ii)
6651 write (iout,*) nn," contacts to processor",iproc,&
6652 " of CONT_TO_COMM group"
6654 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6662 CorrelID1=nfgtasks+fg_rank+1
6664 ! Receive the numbers of needed contacts from other processors
6665 do ii=1,ntask_cont_from
6666 iproc=itask_cont_from(ii)
6668 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
6669 FG_COMM,req(ireq),IERR)
6671 ! write (iout,*) "IRECV ended"
6673 ! Send the number of contacts needed by other processors
6674 do ii=1,ntask_cont_to
6675 iproc=itask_cont_to(ii)
6677 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
6678 FG_COMM,req(ireq),IERR)
6680 ! write (iout,*) "ISEND ended"
6681 ! write (iout,*) "number of requests (nn)",ireq
6684 call MPI_Waitall(ireq,req,status_array,ierr)
6686 ! & "Numbers of contacts to be received from other processors",
6687 ! & (ncont_recv(i),i=1,ntask_cont_from)
6691 do ii=1,ntask_cont_from
6692 iproc=itask_cont_from(ii)
6694 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
6695 ! & " of CONT_TO_COMM group"
6699 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
6700 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6701 ! write (iout,*) "ireq,req",ireq,req(ireq)
6704 ! Send the contacts to processors that need them
6705 do ii=1,ntask_cont_to
6706 iproc=itask_cont_to(ii)
6708 ! write (iout,*) nn," contacts to processor",iproc,
6709 ! & " of CONT_TO_COMM group"
6712 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
6713 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6714 ! write (iout,*) "ireq,req",ireq,req(ireq)
6716 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6720 ! write (iout,*) "number of requests (contacts)",ireq
6721 ! write (iout,*) "req",(req(i),i=1,4)
6724 call MPI_Waitall(ireq,req,status_array,ierr)
6725 do iii=1,ntask_cont_from
6726 iproc=itask_cont_from(iii)
6729 write (iout,*) "Received",nn," contacts from processor",iproc,&
6730 " of CONT_FROM_COMM group"
6733 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6738 ii=zapas_recv(1,i,iii)
6739 ! Flag the received contacts to prevent double-counting
6740 jj=-zapas_recv(2,i,iii)
6741 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6743 nnn=num_cont_hb(ii)+1
6746 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6750 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6755 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6763 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6772 write (iout,'(a)') 'Contact function values after receive:'
6774 write (iout,'(2i3,50(1x,i3,5f6.3))') &
6775 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
6776 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6783 write (iout,'(a)') 'Contact function values:'
6785 write (iout,'(2i3,50(1x,i2,5f6.3))') &
6786 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
6787 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6794 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6795 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6796 ! Remove the loop below after debugging !!!
6803 ! Calculate the dipole-dipole interaction energies
6804 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6805 do i=iatel_s,iatel_e+1
6806 num_conti=num_cont_hb(i)
6815 ! Calculate the local-electrostatic correlation terms
6816 ! write (iout,*) "gradcorr5 in eello5 before loop"
6818 ! write (iout,'(i5,3f10.5)')
6819 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6821 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6822 ! write (iout,*) "corr loop i",i
6824 num_conti=num_cont_hb(i)
6825 num_conti1=num_cont_hb(i+1)
6832 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6833 ! & ' jj=',jj,' kk=',kk
6834 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
6835 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
6836 .or. j.lt.0 .and. j1.gt.0) .and. &
6837 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6838 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6839 ! The system gains extra energy.
6841 sqd1=dsqrt(d_cont(jj,i))
6842 sqd2=dsqrt(d_cont(kk,i1))
6843 sred_geom = sqd1*sqd2
6844 IF (sred_geom.lt.cutoff_corr) THEN
6845 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
6847 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6848 !d & ' jj=',jj,' kk=',kk
6849 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6850 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6852 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6853 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6856 !d write (iout,*) 'sred_geom=',sred_geom,
6857 !d & ' ekont=',ekont,' fprim=',fprimcont,
6858 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6859 !d write (iout,*) "g_contij",g_contij
6860 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6861 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6862 call calc_eello(i,jp,i+1,jp1,jj,kk)
6863 if (wcorr4.gt.0.0d0) &
6864 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6865 if (energy_dec.and.wcorr4.gt.0.0d0) &
6866 write (iout,'(a6,4i5,0pf7.3)') &
6867 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6868 ! write (iout,*) "gradcorr5 before eello5"
6870 ! write (iout,'(i5,3f10.5)')
6871 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6873 if (wcorr5.gt.0.0d0) &
6874 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6875 ! write (iout,*) "gradcorr5 after eello5"
6877 ! write (iout,'(i5,3f10.5)')
6878 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6880 if (energy_dec.and.wcorr5.gt.0.0d0) &
6881 write (iout,'(a6,4i5,0pf7.3)') &
6882 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6883 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6884 !d write(2,*)'ijkl',i,jp,i+1,jp1
6885 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
6886 .or. wturn6.eq.0.0d0))then
6887 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6888 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6889 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
6890 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6891 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6892 !d & 'ecorr6=',ecorr6
6893 !d write (iout,'(4e15.5)') sred_geom,
6894 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6895 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6896 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6897 else if (wturn6.gt.0.0d0 &
6898 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6899 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6900 eturn6=eturn6+eello_turn6(i,jj,kk)
6901 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
6902 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6903 !d write (2,*) 'multibody_eello:eturn6',eturn6
6912 num_cont_hb(i)=num_cont_hb_old(i)
6914 ! write (iout,*) "gradcorr5 in eello5"
6916 ! write (iout,'(i5,3f10.5)')
6917 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
6920 end subroutine multibody_eello
6921 !-----------------------------------------------------------------------------
6922 subroutine add_hb_contact_eello(ii,jj,itask)
6923 ! implicit real*8 (a-h,o-z)
6924 ! include "DIMENSIONS"
6925 ! include "COMMON.IOUNITS"
6926 ! include "COMMON.CONTACTS"
6927 ! integer,parameter :: maxconts=nres/4
6928 integer,parameter :: max_dim=70
6929 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
6930 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6931 ! common /przechowalnia/ zapas
6933 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
6934 integer,dimension(4) ::itask
6935 ! write (iout,*) "itask",itask
6938 if (iproc.gt.0) then
6939 do j=1,num_cont_hb(ii)
6941 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6943 ncont_sent(iproc)=ncont_sent(iproc)+1
6944 nn=ncont_sent(iproc)
6945 zapas(1,nn,iproc)=ii
6946 zapas(2,nn,iproc)=jjc
6947 zapas(3,nn,iproc)=d_cont(j,ii)
6951 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6956 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6964 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6975 end subroutine add_hb_contact_eello
6976 !-----------------------------------------------------------------------------
6977 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6978 ! implicit real*8 (a-h,o-z)
6979 ! include 'DIMENSIONS'
6980 ! include 'COMMON.IOUNITS'
6981 ! include 'COMMON.DERIV'
6982 ! include 'COMMON.INTERACT'
6983 ! include 'COMMON.CONTACTS'
6984 real(kind=8),dimension(3) :: gx,gx1
6987 integer :: i,j,k,l,jj,kk,ll
6988 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
6989 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
6990 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl
7000 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7001 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7002 ! Following 4 lines for diagnostics.
7007 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7008 ! & 'Contacts ',i,j,
7009 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7010 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7012 ! Calculate the multi-body contribution to energy.
7013 ! ecorr=ecorr+ekont*ees
7014 ! Calculate multi-body contributions to the gradient.
7015 coeffpees0pij=coeffp*ees0pij
7016 coeffmees0mij=coeffm*ees0mij
7017 coeffpees0pkl=coeffp*ees0pkl
7018 coeffmees0mkl=coeffm*ees0mkl
7020 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7021 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
7022 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
7023 coeffmees0mkl*gacontm_hb1(ll,jj,i))
7024 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
7025 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
7026 coeffmees0mkl*gacontm_hb2(ll,jj,i))
7027 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7028 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
7029 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
7030 coeffmees0mij*gacontm_hb1(ll,kk,k))
7031 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
7032 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
7033 coeffmees0mij*gacontm_hb2(ll,kk,k))
7034 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
7035 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
7036 coeffmees0mkl*gacontm_hb3(ll,jj,i))
7037 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7038 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7039 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
7040 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
7041 coeffmees0mij*gacontm_hb3(ll,kk,k))
7042 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7043 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7044 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7049 !grad gradcorr(ll,m)=gradcorr(ll,m)+
7050 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
7051 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7052 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7057 !grad gradcorr(ll,m)=gradcorr(ll,m)+
7058 !grad & ees*eij*gacont_hbr(ll,kk,k)-
7059 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7060 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7063 ! write (iout,*) "ehbcorr",ekont*ees
7066 end function ehbcorr
7068 !-----------------------------------------------------------------------------
7069 subroutine dipole(i,j,jj)
7070 ! implicit real*8 (a-h,o-z)
7071 ! include 'DIMENSIONS'
7072 ! include 'COMMON.IOUNITS'
7073 ! include 'COMMON.CHAIN'
7074 ! include 'COMMON.FFIELD'
7075 ! include 'COMMON.DERIV'
7076 ! include 'COMMON.INTERACT'
7077 ! include 'COMMON.CONTACTS'
7078 ! include 'COMMON.TORSION'
7079 ! include 'COMMON.VAR'
7080 ! include 'COMMON.GEO'
7081 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
7082 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
7083 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
7085 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
7086 allocate(dipderx(3,5,4,maxconts,nres))
7089 iti1 = itortyp(itype(i+1))
7090 if (j.lt.nres-1) then
7091 itj1 = itortyp(itype(j+1))
7096 dipi(iii,1)=Ub2(iii,i)
7097 dipderi(iii)=Ub2der(iii,i)
7098 dipi(iii,2)=b1(iii,iti1)
7099 dipj(iii,1)=Ub2(iii,j)
7100 dipderj(iii)=Ub2der(iii,j)
7101 dipj(iii,2)=b1(iii,itj1)
7105 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7108 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7115 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
7119 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7124 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7125 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7127 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7129 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7131 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7134 end subroutine dipole
7136 !-----------------------------------------------------------------------------
7137 subroutine calc_eello(i,j,k,l,jj,kk)
7139 ! This subroutine computes matrices and vectors needed to calculate
7140 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
7143 ! implicit real*8 (a-h,o-z)
7144 ! include 'DIMENSIONS'
7145 ! include 'COMMON.IOUNITS'
7146 ! include 'COMMON.CHAIN'
7147 ! include 'COMMON.DERIV'
7148 ! include 'COMMON.INTERACT'
7149 ! include 'COMMON.CONTACTS'
7150 ! include 'COMMON.TORSION'
7151 ! include 'COMMON.VAR'
7152 ! include 'COMMON.GEO'
7153 ! include 'COMMON.FFIELD'
7154 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
7155 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
7156 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
7159 !el common /kutas/ lprn
7160 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7161 !d & ' jj=',jj,' kk=',kk
7162 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7163 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7164 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7167 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7168 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7171 call transpose2(aa1(1,1),aa1t(1,1))
7172 call transpose2(aa2(1,1),aa2t(1,1))
7175 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
7176 aa1tder(1,1,lll,kkk))
7177 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
7178 aa2tder(1,1,lll,kkk))
7182 ! parallel orientation of the two CA-CA-CA frames.
7184 iti=itortyp(itype(i))
7188 itk1=itortyp(itype(k+1))
7189 itj=itortyp(itype(j))
7190 if (l.lt.nres-1) then
7191 itl1=itortyp(itype(l+1))
7195 ! A1 kernel(j+1) A2T
7197 !d write (iout,'(3f10.5,5x,3f10.5)')
7198 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7200 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7201 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
7202 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7203 ! Following matrices are needed only for 6-th order cumulants
7204 IF (wcorr6.gt.0.0d0) THEN
7205 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7206 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
7207 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7208 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7209 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
7210 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
7211 ADtEAderx(1,1,1,1,1,1))
7213 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7214 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
7215 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
7216 ADtEA1derx(1,1,1,1,1,1))
7218 ! End 6-th order cumulants
7221 !d write (2,*) 'In calc_eello6'
7223 !d write (2,*) 'iii=',iii
7225 !d write (2,*) 'kkk=',kkk
7227 !d write (2,'(3(2f10.5),5x)')
7228 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7233 call transpose2(EUgder(1,1,k),auxmat(1,1))
7234 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7235 call transpose2(EUg(1,1,k),auxmat(1,1))
7236 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7237 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7241 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7242 EAEAderx(1,1,lll,kkk,iii,1))
7246 ! A1T kernel(i+1) A2
7247 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7248 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
7249 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7250 ! Following matrices are needed only for 6-th order cumulants
7251 IF (wcorr6.gt.0.0d0) THEN
7252 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7253 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
7254 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7255 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7256 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
7257 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
7258 ADtEAderx(1,1,1,1,1,2))
7259 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7260 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
7261 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
7262 ADtEA1derx(1,1,1,1,1,2))
7264 ! End 6-th order cumulants
7265 call transpose2(EUgder(1,1,l),auxmat(1,1))
7266 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7267 call transpose2(EUg(1,1,l),auxmat(1,1))
7268 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7269 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7273 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7274 EAEAderx(1,1,lll,kkk,iii,2))
7279 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7280 ! They are needed only when the fifth- or the sixth-order cumulants are
7282 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7283 call transpose2(AEA(1,1,1),auxmat(1,1))
7284 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7285 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7286 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7287 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7288 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7289 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7290 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7291 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7292 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7293 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7294 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7295 call transpose2(AEA(1,1,2),auxmat(1,1))
7296 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7297 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7298 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7299 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7300 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7301 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7302 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7303 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7304 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7305 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7306 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7307 ! Calculate the Cartesian derivatives of the vectors.
7311 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7312 call matvec2(auxmat(1,1),b1(1,iti),&
7313 AEAb1derx(1,lll,kkk,iii,1,1))
7314 call matvec2(auxmat(1,1),Ub2(1,i),&
7315 AEAb2derx(1,lll,kkk,iii,1,1))
7316 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
7317 AEAb1derx(1,lll,kkk,iii,2,1))
7318 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
7319 AEAb2derx(1,lll,kkk,iii,2,1))
7320 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7321 call matvec2(auxmat(1,1),b1(1,itj),&
7322 AEAb1derx(1,lll,kkk,iii,1,2))
7323 call matvec2(auxmat(1,1),Ub2(1,j),&
7324 AEAb2derx(1,lll,kkk,iii,1,2))
7325 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
7326 AEAb1derx(1,lll,kkk,iii,2,2))
7327 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
7328 AEAb2derx(1,lll,kkk,iii,2,2))
7335 ! Antiparallel orientation of the two CA-CA-CA frames.
7337 iti=itortyp(itype(i))
7341 itk1=itortyp(itype(k+1))
7342 itl=itortyp(itype(l))
7343 itj=itortyp(itype(j))
7344 if (j.lt.nres-1) then
7345 itj1=itortyp(itype(j+1))
7349 ! A2 kernel(j-1)T A1T
7350 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7351 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
7352 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7353 ! Following matrices are needed only for 6-th order cumulants
7354 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
7355 j.eq.i+4 .and. l.eq.i+3)) THEN
7356 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7357 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
7358 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7359 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7360 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
7361 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
7362 ADtEAderx(1,1,1,1,1,1))
7363 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7364 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
7365 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
7366 ADtEA1derx(1,1,1,1,1,1))
7368 ! End 6-th order cumulants
7369 call transpose2(EUgder(1,1,k),auxmat(1,1))
7370 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7371 call transpose2(EUg(1,1,k),auxmat(1,1))
7372 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7373 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7377 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7378 EAEAderx(1,1,lll,kkk,iii,1))
7382 ! A2T kernel(i+1)T A1
7383 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7384 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
7385 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7386 ! Following matrices are needed only for 6-th order cumulants
7387 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
7388 j.eq.i+4 .and. l.eq.i+3)) THEN
7389 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7390 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
7391 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7392 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7393 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
7394 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
7395 ADtEAderx(1,1,1,1,1,2))
7396 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
7397 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
7398 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
7399 ADtEA1derx(1,1,1,1,1,2))
7401 ! End 6-th order cumulants
7402 call transpose2(EUgder(1,1,j),auxmat(1,1))
7403 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7404 call transpose2(EUg(1,1,j),auxmat(1,1))
7405 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7406 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7410 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7411 EAEAderx(1,1,lll,kkk,iii,2))
7416 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7417 ! They are needed only when the fifth- or the sixth-order cumulants are
7419 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
7420 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7421 call transpose2(AEA(1,1,1),auxmat(1,1))
7422 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7423 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7424 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7425 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7426 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7427 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7428 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7429 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7430 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7431 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7432 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7433 call transpose2(AEA(1,1,2),auxmat(1,1))
7434 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7435 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7436 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7437 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7438 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7439 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7440 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7441 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7442 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7443 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7444 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7445 ! Calculate the Cartesian derivatives of the vectors.
7449 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7450 call matvec2(auxmat(1,1),b1(1,iti),&
7451 AEAb1derx(1,lll,kkk,iii,1,1))
7452 call matvec2(auxmat(1,1),Ub2(1,i),&
7453 AEAb2derx(1,lll,kkk,iii,1,1))
7454 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
7455 AEAb1derx(1,lll,kkk,iii,2,1))
7456 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
7457 AEAb2derx(1,lll,kkk,iii,2,1))
7458 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7459 call matvec2(auxmat(1,1),b1(1,itl),&
7460 AEAb1derx(1,lll,kkk,iii,1,2))
7461 call matvec2(auxmat(1,1),Ub2(1,l),&
7462 AEAb2derx(1,lll,kkk,iii,1,2))
7463 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
7464 AEAb1derx(1,lll,kkk,iii,2,2))
7465 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
7466 AEAb2derx(1,lll,kkk,iii,2,2))
7474 end subroutine calc_eello
7475 !-----------------------------------------------------------------------------
7476 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
7481 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
7482 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
7483 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
7484 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
7485 integer :: iii,kkk,lll
7488 !el common /kutas/ lprn
7489 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7491 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
7494 !d if (lprn) write (2,*) 'In kernel'
7496 !d if (lprn) write (2,*) 'kkk=',kkk
7498 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
7499 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7501 !d write (2,*) 'lll=',lll
7502 !d write (2,*) 'iii=1'
7504 !d write (2,'(3(2f10.5),5x)')
7505 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7508 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
7509 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7511 !d write (2,*) 'lll=',lll
7512 !d write (2,*) 'iii=2'
7514 !d write (2,'(3(2f10.5),5x)')
7515 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7521 end subroutine kernel
7522 !-----------------------------------------------------------------------------
7523 real(kind=8) function eello4(i,j,k,l,jj,kk)
7524 ! implicit real*8 (a-h,o-z)
7525 ! include 'DIMENSIONS'
7526 ! include 'COMMON.IOUNITS'
7527 ! include 'COMMON.CHAIN'
7528 ! include 'COMMON.DERIV'
7529 ! include 'COMMON.INTERACT'
7530 ! include 'COMMON.CONTACTS'
7531 ! include 'COMMON.TORSION'
7532 ! include 'COMMON.VAR'
7533 ! include 'COMMON.GEO'
7534 real(kind=8),dimension(2,2) :: pizda
7535 real(kind=8),dimension(3) :: ggg1,ggg2
7536 real(kind=8) :: eel4,glongij,glongkl
7537 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
7538 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7542 !d print *,'eello4:',i,j,k,l,jj,kk
7543 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
7544 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
7545 !old eij=facont_hb(jj,i)
7546 !old ekl=facont_hb(kk,k)
7548 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7549 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7550 gcorr_loc(k-1)=gcorr_loc(k-1) &
7551 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7553 gcorr_loc(l-1)=gcorr_loc(l-1) &
7554 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7556 gcorr_loc(j-1)=gcorr_loc(j-1) &
7557 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7562 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
7563 -EAEAderx(2,2,lll,kkk,iii,1)
7564 !d derx(lll,kkk,iii)=0.0d0
7568 !d gcorr_loc(l-1)=0.0d0
7569 !d gcorr_loc(j-1)=0.0d0
7570 !d gcorr_loc(k-1)=0.0d0
7572 !d write (iout,*)'Contacts have occurred for peptide groups',
7573 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
7574 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7575 if (j.lt.nres-1) then
7582 if (l.lt.nres-1) then
7590 !grad ggg1(ll)=eel4*g_contij(ll,1)
7591 !grad ggg2(ll)=eel4*g_contij(ll,2)
7592 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7593 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7594 !grad ghalf=0.5d0*ggg1(ll)
7595 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7596 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7597 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7598 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7599 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7600 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7601 !grad ghalf=0.5d0*ggg2(ll)
7602 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7603 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7604 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7605 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7606 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7607 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7611 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7616 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7621 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7626 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7630 !d write (2,*) iii,gcorr_loc(iii)
7633 !d write (2,*) 'ekont',ekont
7634 !d write (iout,*) 'eello4',ekont*eel4
7637 !-----------------------------------------------------------------------------
7638 real(kind=8) function eello5(i,j,k,l,jj,kk)
7639 ! implicit real*8 (a-h,o-z)
7640 ! include 'DIMENSIONS'
7641 ! include 'COMMON.IOUNITS'
7642 ! include 'COMMON.CHAIN'
7643 ! include 'COMMON.DERIV'
7644 ! include 'COMMON.INTERACT'
7645 ! include 'COMMON.CONTACTS'
7646 ! include 'COMMON.TORSION'
7647 ! include 'COMMON.VAR'
7648 ! include 'COMMON.GEO'
7649 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
7650 real(kind=8),dimension(2) :: vv
7651 real(kind=8),dimension(3) :: ggg1,ggg2
7652 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
7653 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
7654 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
7655 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7660 ! /l\ / \ \ / \ / \ / C
7661 ! / \ / \ \ / \ / \ / C
7662 ! j| o |l1 | o | o| o | | o |o C
7663 ! \ |/k\| |/ \| / |/ \| |/ \| C
7664 ! \i/ \ / \ / / \ / \ C
7666 ! (I) (II) (III) (IV) C
7668 ! eello5_1 eello5_2 eello5_3 eello5_4 C
7670 ! Antiparallel chains C
7673 ! /j\ / \ \ / \ / \ / C
7674 ! / \ / \ \ / \ / \ / C
7675 ! j1| o |l | o | o| o | | o |o C
7676 ! \ |/k\| |/ \| / |/ \| |/ \| C
7677 ! \i/ \ / \ / / \ / \ C
7679 ! (I) (II) (III) (IV) C
7681 ! eello5_1 eello5_2 eello5_3 eello5_4 C
7683 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
7685 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7686 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7691 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7693 itk=itortyp(itype(k))
7694 itl=itortyp(itype(l))
7695 itj=itortyp(itype(j))
7700 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7701 !d & eel5_3_num,eel5_4_num)
7705 derx(lll,kkk,iii)=0.0d0
7709 !d eij=facont_hb(jj,i)
7710 !d ekl=facont_hb(kk,k)
7712 !d write (iout,*)'Contacts have occurred for peptide groups',
7713 !d & i,j,' fcont:',eij,' eij',' and ',k,l
7715 ! Contribution from the graph I.
7716 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7717 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7718 call transpose2(EUg(1,1,k),auxmat(1,1))
7719 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7720 vv(1)=pizda(1,1)-pizda(2,2)
7721 vv(2)=pizda(1,2)+pizda(2,1)
7722 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
7723 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7724 ! Explicit gradient in virtual-dihedral angles.
7725 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
7726 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
7727 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7728 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7729 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7730 vv(1)=pizda(1,1)-pizda(2,2)
7731 vv(2)=pizda(1,2)+pizda(2,1)
7732 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7733 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
7734 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7735 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7736 vv(1)=pizda(1,1)-pizda(2,2)
7737 vv(2)=pizda(1,2)+pizda(2,1)
7739 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7740 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
7741 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7743 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7744 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
7745 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7747 ! Cartesian gradient
7751 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
7753 vv(1)=pizda(1,1)-pizda(2,2)
7754 vv(2)=pizda(1,2)+pizda(2,1)
7755 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7756 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
7757 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7763 ! Contribution from graph II
7764 call transpose2(EE(1,1,itk),auxmat(1,1))
7765 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7766 vv(1)=pizda(1,1)+pizda(2,2)
7767 vv(2)=pizda(2,1)-pizda(1,2)
7768 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
7769 -0.5d0*scalar2(vv(1),Ctobr(1,k))
7770 ! Explicit gradient in virtual-dihedral angles.
7771 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7772 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7773 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7774 vv(1)=pizda(1,1)+pizda(2,2)
7775 vv(2)=pizda(2,1)-pizda(1,2)
7777 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7778 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
7779 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7781 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7782 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
7783 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7785 ! Cartesian gradient
7789 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7791 vv(1)=pizda(1,1)+pizda(2,2)
7792 vv(2)=pizda(2,1)-pizda(1,2)
7793 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7794 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
7795 -0.5d0*scalar2(vv(1),Ctobr(1,k))
7803 ! Parallel orientation
7804 ! Contribution from graph III
7805 call transpose2(EUg(1,1,l),auxmat(1,1))
7806 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7807 vv(1)=pizda(1,1)-pizda(2,2)
7808 vv(2)=pizda(1,2)+pizda(2,1)
7809 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
7810 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7811 ! Explicit gradient in virtual-dihedral angles.
7812 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7813 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
7814 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7815 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7816 vv(1)=pizda(1,1)-pizda(2,2)
7817 vv(2)=pizda(1,2)+pizda(2,1)
7818 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7819 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
7820 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7821 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7822 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7823 vv(1)=pizda(1,1)-pizda(2,2)
7824 vv(2)=pizda(1,2)+pizda(2,1)
7825 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7826 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
7827 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7828 ! Cartesian gradient
7832 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
7834 vv(1)=pizda(1,1)-pizda(2,2)
7835 vv(2)=pizda(1,2)+pizda(2,1)
7836 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7837 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
7838 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7843 ! Contribution from graph IV
7845 call transpose2(EE(1,1,itl),auxmat(1,1))
7846 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7847 vv(1)=pizda(1,1)+pizda(2,2)
7848 vv(2)=pizda(2,1)-pizda(1,2)
7849 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
7850 -0.5d0*scalar2(vv(1),Ctobr(1,l))
7851 ! Explicit gradient in virtual-dihedral angles.
7852 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7853 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7854 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7855 vv(1)=pizda(1,1)+pizda(2,2)
7856 vv(2)=pizda(2,1)-pizda(1,2)
7857 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7858 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
7859 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7860 ! Cartesian gradient
7864 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7866 vv(1)=pizda(1,1)+pizda(2,2)
7867 vv(2)=pizda(2,1)-pizda(1,2)
7868 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
7869 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
7870 -0.5d0*scalar2(vv(1),Ctobr(1,l))
7875 ! Antiparallel orientation
7876 ! Contribution from graph III
7878 call transpose2(EUg(1,1,j),auxmat(1,1))
7879 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7880 vv(1)=pizda(1,1)-pizda(2,2)
7881 vv(2)=pizda(1,2)+pizda(2,1)
7882 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
7883 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7884 ! Explicit gradient in virtual-dihedral angles.
7885 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
7886 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
7887 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7888 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7889 vv(1)=pizda(1,1)-pizda(2,2)
7890 vv(2)=pizda(1,2)+pizda(2,1)
7891 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7892 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
7893 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7894 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7895 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7896 vv(1)=pizda(1,1)-pizda(2,2)
7897 vv(2)=pizda(1,2)+pizda(2,1)
7898 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7899 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
7900 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7901 ! Cartesian gradient
7905 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
7907 vv(1)=pizda(1,1)-pizda(2,2)
7908 vv(2)=pizda(1,2)+pizda(2,1)
7909 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
7910 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
7911 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7916 ! Contribution from graph IV
7918 call transpose2(EE(1,1,itj),auxmat(1,1))
7919 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7920 vv(1)=pizda(1,1)+pizda(2,2)
7921 vv(2)=pizda(2,1)-pizda(1,2)
7922 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
7923 -0.5d0*scalar2(vv(1),Ctobr(1,j))
7924 ! Explicit gradient in virtual-dihedral angles.
7925 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
7926 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7927 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7928 vv(1)=pizda(1,1)+pizda(2,2)
7929 vv(2)=pizda(2,1)-pizda(1,2)
7930 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
7931 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
7932 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7933 ! Cartesian gradient
7937 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7939 vv(1)=pizda(1,1)+pizda(2,2)
7940 vv(2)=pizda(2,1)-pizda(1,2)
7941 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
7942 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
7943 -0.5d0*scalar2(vv(1),Ctobr(1,j))
7949 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7950 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7951 !d write (2,*) 'ijkl',i,j,k,l
7952 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7953 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
7955 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7956 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7957 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7958 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7959 if (j.lt.nres-1) then
7966 if (l.lt.nres-1) then
7976 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7977 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
7978 ! summed up outside the subrouine as for the other subroutines
7979 ! handling long-range interactions. The old code is commented out
7980 ! with "cgrad" to keep track of changes.
7982 !grad ggg1(ll)=eel5*g_contij(ll,1)
7983 !grad ggg2(ll)=eel5*g_contij(ll,2)
7984 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7985 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7986 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7987 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7988 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7989 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7990 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7991 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7993 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7994 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7995 !grad ghalf=0.5d0*ggg1(ll)
7997 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7998 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7999 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8000 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8001 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8002 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8003 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8004 !grad ghalf=0.5d0*ggg2(ll)
8006 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8007 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8008 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8009 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8010 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8011 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8016 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8017 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8022 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8023 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8029 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8034 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8038 !d write (2,*) iii,g_corr5_loc(iii)
8041 !d write (2,*) 'ekont',ekont
8042 !d write (iout,*) 'eello5',ekont*eel5
8045 !-----------------------------------------------------------------------------
8046 real(kind=8) function eello6(i,j,k,l,jj,kk)
8047 ! implicit real*8 (a-h,o-z)
8048 ! include 'DIMENSIONS'
8049 ! include 'COMMON.IOUNITS'
8050 ! include 'COMMON.CHAIN'
8051 ! include 'COMMON.DERIV'
8052 ! include 'COMMON.INTERACT'
8053 ! include 'COMMON.CONTACTS'
8054 ! include 'COMMON.TORSION'
8055 ! include 'COMMON.VAR'
8056 ! include 'COMMON.GEO'
8057 ! include 'COMMON.FFIELD'
8058 real(kind=8),dimension(3) :: ggg1,ggg2
8059 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
8061 real(kind=8) :: gradcorr6ij,gradcorr6kl
8062 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
8063 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8068 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8076 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8077 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8081 derx(lll,kkk,iii)=0.0d0
8085 !d eij=facont_hb(jj,i)
8086 !d ekl=facont_hb(kk,k)
8092 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8093 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8094 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8095 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8096 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8097 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8099 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8100 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8101 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8102 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8103 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8104 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8108 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8110 ! If turn contributions are considered, they will be handled separately.
8111 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8112 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8113 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8114 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8115 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8116 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8117 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8119 if (j.lt.nres-1) then
8126 if (l.lt.nres-1) then
8134 !grad ggg1(ll)=eel6*g_contij(ll,1)
8135 !grad ggg2(ll)=eel6*g_contij(ll,2)
8136 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8137 !grad ghalf=0.5d0*ggg1(ll)
8139 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8140 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8141 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8142 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8143 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8144 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8145 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8146 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8147 !grad ghalf=0.5d0*ggg2(ll)
8148 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8150 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8151 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8152 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8153 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8154 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8155 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8160 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8161 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8166 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8167 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8173 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8178 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8182 !d write (2,*) iii,g_corr6_loc(iii)
8185 !d write (2,*) 'ekont',ekont
8186 !d write (iout,*) 'eello6',ekont*eel6
8189 !-----------------------------------------------------------------------------
8190 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
8192 ! implicit real*8 (a-h,o-z)
8193 ! include 'DIMENSIONS'
8194 ! include 'COMMON.IOUNITS'
8195 ! include 'COMMON.CHAIN'
8196 ! include 'COMMON.DERIV'
8197 ! include 'COMMON.INTERACT'
8198 ! include 'COMMON.CONTACTS'
8199 ! include 'COMMON.TORSION'
8200 ! include 'COMMON.VAR'
8201 ! include 'COMMON.GEO'
8202 real(kind=8),dimension(2) :: vv,vv1
8203 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
8206 !el common /kutas/ lprn
8207 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
8208 real(kind=8) :: s1,s2,s3,s4,s5
8209 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8211 ! Parallel Antiparallel C
8217 ! \ j|/k\| / \ |/k\|l / C
8222 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8223 itk=itortyp(itype(k))
8224 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8225 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8226 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8227 call transpose2(EUgC(1,1,k),auxmat(1,1))
8228 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8229 vv1(1)=pizda1(1,1)-pizda1(2,2)
8230 vv1(2)=pizda1(1,2)+pizda1(2,1)
8231 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8232 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8233 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8234 s5=scalar2(vv(1),Dtobr2(1,i))
8235 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8236 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8237 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
8238 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
8239 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
8240 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
8241 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
8242 +scalar2(vv(1),Dtobr2der(1,i)))
8243 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8244 vv1(1)=pizda1(1,1)-pizda1(2,2)
8245 vv1(2)=pizda1(1,2)+pizda1(2,1)
8246 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8247 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8249 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
8250 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
8251 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
8252 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
8253 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8255 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
8256 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
8257 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
8258 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
8259 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8261 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8262 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8263 vv1(1)=pizda1(1,1)-pizda1(2,2)
8264 vv1(2)=pizda1(1,2)+pizda1(2,1)
8265 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
8266 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
8267 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
8268 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8277 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8278 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8279 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8280 call transpose2(EUgC(1,1,k),auxmat(1,1))
8281 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
8283 vv1(1)=pizda1(1,1)-pizda1(2,2)
8284 vv1(2)=pizda1(1,2)+pizda1(2,1)
8285 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8286 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
8287 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8288 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
8289 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8290 s5=scalar2(vv(1),Dtobr2(1,i))
8291 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8296 end function eello6_graph1
8297 !-----------------------------------------------------------------------------
8298 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
8300 ! implicit real*8 (a-h,o-z)
8301 ! include 'DIMENSIONS'
8302 ! include 'COMMON.IOUNITS'
8303 ! include 'COMMON.CHAIN'
8304 ! include 'COMMON.DERIV'
8305 ! include 'COMMON.INTERACT'
8306 ! include 'COMMON.CONTACTS'
8307 ! include 'COMMON.TORSION'
8308 ! include 'COMMON.VAR'
8309 ! include 'COMMON.GEO'
8311 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
8312 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8314 !el common /kutas/ lprn
8315 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
8316 real(kind=8) :: s2,s3,s4
8317 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8319 ! Parallel Antiparallel C
8325 ! \ j|/k\| \ |/k\|l C
8330 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8331 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8332 ! AL 7/4/01 s1 would occur in the sixth-order moment,
8333 ! but not in a cluster cumulant
8335 s1=dip(1,jj,i)*dip(1,kk,k)
8337 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8338 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8339 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8340 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8341 call transpose2(EUg(1,1,k),auxmat(1,1))
8342 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8343 vv(1)=pizda(1,1)-pizda(2,2)
8344 vv(2)=pizda(1,2)+pizda(2,1)
8345 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8346 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8348 eello6_graph2=-(s1+s2+s3+s4)
8350 eello6_graph2=-(s2+s3+s4)
8353 ! Derivatives in gamma(i-1)
8356 s1=dipderg(1,jj,i)*dip(1,kk,k)
8358 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8359 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8360 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8361 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8363 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8365 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8367 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8369 ! Derivatives in gamma(k-1)
8371 s1=dip(1,jj,i)*dipderg(1,kk,k)
8373 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8374 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8375 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8376 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8377 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8378 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8379 vv(1)=pizda(1,1)-pizda(2,2)
8380 vv(2)=pizda(1,2)+pizda(2,1)
8381 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8383 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8385 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8387 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8388 ! Derivatives in gamma(j-1) or gamma(l-1)
8391 s1=dipderg(3,jj,i)*dip(1,kk,k)
8393 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8394 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8395 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8396 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8397 vv(1)=pizda(1,1)-pizda(2,2)
8398 vv(2)=pizda(1,2)+pizda(2,1)
8399 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8402 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8404 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8407 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8408 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8410 ! Derivatives in gamma(l-1) or gamma(j-1)
8413 s1=dip(1,jj,i)*dipderg(3,kk,k)
8415 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8416 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8417 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8418 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8419 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8420 vv(1)=pizda(1,1)-pizda(2,2)
8421 vv(2)=pizda(1,2)+pizda(2,1)
8422 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8425 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8427 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8430 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8431 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8433 ! Cartesian derivatives.
8435 write (2,*) 'In eello6_graph2'
8437 write (2,*) 'iii=',iii
8439 write (2,*) 'kkk=',kkk
8441 write (2,'(3(2f10.5),5x)') &
8442 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8452 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8454 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8457 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
8459 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8460 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
8462 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8463 call transpose2(EUg(1,1,k),auxmat(1,1))
8464 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8466 vv(1)=pizda(1,1)-pizda(2,2)
8467 vv(2)=pizda(1,2)+pizda(2,1)
8468 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8469 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8471 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8473 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8476 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8478 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8484 end function eello6_graph2
8485 !-----------------------------------------------------------------------------
8486 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
8487 ! implicit real*8 (a-h,o-z)
8488 ! include 'DIMENSIONS'
8489 ! include 'COMMON.IOUNITS'
8490 ! include 'COMMON.CHAIN'
8491 ! include 'COMMON.DERIV'
8492 ! include 'COMMON.INTERACT'
8493 ! include 'COMMON.CONTACTS'
8494 ! include 'COMMON.TORSION'
8495 ! include 'COMMON.VAR'
8496 ! include 'COMMON.GEO'
8497 real(kind=8),dimension(2) :: vv,auxvec
8498 real(kind=8),dimension(2,2) :: pizda,auxmat
8500 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
8501 real(kind=8) :: s1,s2,s3,s4
8502 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8504 ! Parallel Antiparallel C
8510 ! j|/k\| / |/k\|l / C
8515 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8517 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
8518 ! energy moment and not to the cluster cumulant.
8519 iti=itortyp(itype(i))
8520 if (j.lt.nres-1) then
8521 itj1=itortyp(itype(j+1))
8525 itk=itortyp(itype(k))
8526 itk1=itortyp(itype(k+1))
8527 if (l.lt.nres-1) then
8528 itl1=itortyp(itype(l+1))
8533 s1=dip(4,jj,i)*dip(4,kk,k)
8535 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8536 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8537 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8538 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8539 call transpose2(EE(1,1,itk),auxmat(1,1))
8540 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8541 vv(1)=pizda(1,1)+pizda(2,2)
8542 vv(2)=pizda(2,1)-pizda(1,2)
8543 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8544 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8545 !d & "sum",-(s2+s3+s4)
8547 eello6_graph3=-(s1+s2+s3+s4)
8549 eello6_graph3=-(s2+s3+s4)
8552 ! Derivatives in gamma(k-1)
8553 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8554 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8555 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8556 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8557 ! Derivatives in gamma(l-1)
8558 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8559 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8560 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8561 vv(1)=pizda(1,1)+pizda(2,2)
8562 vv(2)=pizda(2,1)-pizda(1,2)
8563 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8564 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8565 ! Cartesian derivatives.
8571 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8573 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8576 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8578 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8579 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8581 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8582 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
8584 vv(1)=pizda(1,1)+pizda(2,2)
8585 vv(2)=pizda(2,1)-pizda(1,2)
8586 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8588 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8590 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8593 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8595 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8597 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8602 end function eello6_graph3
8603 !-----------------------------------------------------------------------------
8604 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8605 ! implicit real*8 (a-h,o-z)
8606 ! include 'DIMENSIONS'
8607 ! include 'COMMON.IOUNITS'
8608 ! include 'COMMON.CHAIN'
8609 ! include 'COMMON.DERIV'
8610 ! include 'COMMON.INTERACT'
8611 ! include 'COMMON.CONTACTS'
8612 ! include 'COMMON.TORSION'
8613 ! include 'COMMON.VAR'
8614 ! include 'COMMON.GEO'
8615 ! include 'COMMON.FFIELD'
8616 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
8617 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8619 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
8621 real(kind=8) :: s1,s2,s3,s4
8622 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8624 ! Parallel Antiparallel C
8630 ! \ j|/k\| \ |/k\|l C
8635 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8637 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
8638 ! energy moment and not to the cluster cumulant.
8639 !d write (2,*) 'eello_graph4: wturn6',wturn6
8640 iti=itortyp(itype(i))
8641 itj=itortyp(itype(j))
8642 if (j.lt.nres-1) then
8643 itj1=itortyp(itype(j+1))
8647 itk=itortyp(itype(k))
8648 if (k.lt.nres-1) then
8649 itk1=itortyp(itype(k+1))
8653 itl=itortyp(itype(l))
8654 if (l.lt.nres-1) then
8655 itl1=itortyp(itype(l+1))
8659 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8660 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8661 !d & ' itl',itl,' itl1',itl1
8664 s1=dip(3,jj,i)*dip(3,kk,k)
8666 s1=dip(2,jj,j)*dip(2,kk,l)
8669 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8670 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8672 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8673 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8675 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8676 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8678 call transpose2(EUg(1,1,k),auxmat(1,1))
8679 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8680 vv(1)=pizda(1,1)-pizda(2,2)
8681 vv(2)=pizda(2,1)+pizda(1,2)
8682 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8683 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8685 eello6_graph4=-(s1+s2+s3+s4)
8687 eello6_graph4=-(s2+s3+s4)
8689 ! Derivatives in gamma(i-1)
8693 s1=dipderg(2,jj,i)*dip(3,kk,k)
8695 s1=dipderg(4,jj,j)*dip(2,kk,l)
8698 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8700 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8701 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8703 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8704 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8706 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8707 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8708 !d write (2,*) 'turn6 derivatives'
8710 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8712 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8716 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8718 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8722 ! Derivatives in gamma(k-1)
8725 s1=dip(3,jj,i)*dipderg(2,kk,k)
8727 s1=dip(2,jj,j)*dipderg(4,kk,l)
8730 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8731 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8733 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8734 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8736 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8737 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8739 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8740 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8741 vv(1)=pizda(1,1)-pizda(2,2)
8742 vv(2)=pizda(2,1)+pizda(1,2)
8743 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8744 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8746 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8748 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8752 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8754 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8757 ! Derivatives in gamma(j-1) or gamma(l-1)
8758 if (l.eq.j+1 .and. l.gt.1) then
8759 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8760 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8761 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8762 vv(1)=pizda(1,1)-pizda(2,2)
8763 vv(2)=pizda(2,1)+pizda(1,2)
8764 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8765 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8766 else if (j.gt.1) then
8767 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8768 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8769 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8770 vv(1)=pizda(1,1)-pizda(2,2)
8771 vv(2)=pizda(2,1)+pizda(1,2)
8772 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8773 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8774 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8776 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8779 ! Cartesian derivatives.
8786 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8788 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8792 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8794 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8798 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
8800 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8802 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
8803 b1(1,itj1),auxvec(1))
8804 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8806 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
8807 b1(1,itl1),auxvec(1))
8808 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8810 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
8812 vv(1)=pizda(1,1)-pizda(2,2)
8813 vv(2)=pizda(2,1)+pizda(1,2)
8814 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8816 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8818 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
8821 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
8824 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8827 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8829 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8831 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8835 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8837 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8840 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8842 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8849 end function eello6_graph4
8850 !-----------------------------------------------------------------------------
8851 real(kind=8) function eello_turn6(i,jj,kk)
8852 ! implicit real*8 (a-h,o-z)
8853 ! include 'DIMENSIONS'
8854 ! include 'COMMON.IOUNITS'
8855 ! include 'COMMON.CHAIN'
8856 ! include 'COMMON.DERIV'
8857 ! include 'COMMON.INTERACT'
8858 ! include 'COMMON.CONTACTS'
8859 ! include 'COMMON.TORSION'
8860 ! include 'COMMON.VAR'
8861 ! include 'COMMON.GEO'
8862 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
8863 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
8864 real(kind=8),dimension(3) :: ggg1,ggg2
8865 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
8866 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
8867 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8868 ! the respective energy moment and not to the cluster cumulant.
8870 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
8871 integer :: j1,j2,l1,l2,ll
8872 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
8873 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
8882 iti=itortyp(itype(i))
8883 itk=itortyp(itype(k))
8884 itk1=itortyp(itype(k+1))
8885 itl=itortyp(itype(l))
8886 itj=itortyp(itype(j))
8887 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8888 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
8889 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8894 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8896 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
8900 derx_turn(lll,kkk,iii)=0.0d0
8907 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8909 !d write (2,*) 'eello6_5',eello6_5
8911 call transpose2(AEA(1,1,1),auxmat(1,1))
8912 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8913 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8914 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8916 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8917 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8918 s2 = scalar2(b1(1,itk),vtemp1(1))
8920 call transpose2(AEA(1,1,2),atemp(1,1))
8921 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8922 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8923 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8925 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8926 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8927 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8929 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8930 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8931 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8932 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8933 ss13 = scalar2(b1(1,itk),vtemp4(1))
8934 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8936 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8942 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8943 ! Derivatives in gamma(i+2)
8947 call transpose2(AEA(1,1,1),auxmatd(1,1))
8948 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8949 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8950 call transpose2(AEAderg(1,1,2),atempd(1,1))
8951 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8952 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8954 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8955 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8956 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8962 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8963 ! Derivatives in gamma(i+3)
8965 call transpose2(AEA(1,1,1),auxmatd(1,1))
8966 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8967 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8968 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8970 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8971 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8972 s2d = scalar2(b1(1,itk),vtemp1d(1))
8974 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8975 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8977 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8979 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8980 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8981 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8989 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
8990 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8992 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
8993 -0.5d0*ekont*(s2d+s12d)
8995 ! Derivatives in gamma(i+4)
8996 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8997 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8998 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9000 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9001 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9002 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9010 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9012 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9014 ! Derivatives in gamma(i+5)
9016 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9017 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9018 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9020 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9021 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9022 s2d = scalar2(b1(1,itk),vtemp1d(1))
9024 call transpose2(AEA(1,1,2),atempd(1,1))
9025 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9026 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9028 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9029 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9031 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9032 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9033 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9041 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
9042 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9044 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
9045 -0.5d0*ekont*(s2d+s12d)
9047 ! Cartesian derivatives
9052 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9053 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9054 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9056 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9057 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
9059 s2d = scalar2(b1(1,itk),vtemp1d(1))
9061 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9062 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9063 s8d = -(atempd(1,1)+atempd(2,2))* &
9064 scalar2(cc(1,1,itl),vtemp2(1))
9066 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
9068 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9069 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9076 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
9079 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
9083 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
9086 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
9095 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
9097 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9098 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9099 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9100 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9101 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
9103 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9104 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9105 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9109 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9110 !d & 16*eel_turn6_num
9112 if (j.lt.nres-1) then
9119 if (l.lt.nres-1) then
9127 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
9128 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
9129 !grad ghalf=0.5d0*ggg1(ll)
9131 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9132 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9133 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
9134 +ekont*derx_turn(ll,2,1)
9135 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9136 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
9137 +ekont*derx_turn(ll,4,1)
9138 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9139 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9140 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9141 !grad ghalf=0.5d0*ggg2(ll)
9143 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
9144 +ekont*derx_turn(ll,2,2)
9145 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9146 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
9147 +ekont*derx_turn(ll,4,2)
9148 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9149 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9150 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9155 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9160 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9166 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9171 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9175 !d write (2,*) iii,g_corr6_loc(iii)
9177 eello_turn6=ekont*eel_turn6
9178 !d write (2,*) 'ekont',ekont
9179 !d write (2,*) 'eel_turn6',ekont*eel_turn6
9181 end function eello_turn6
9182 !-----------------------------------------------------------------------------
9183 subroutine MATVEC2(A1,V1,V2)
9184 !DIR$ INLINEALWAYS MATVEC2
9186 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9188 ! implicit real*8 (a-h,o-z)
9189 ! include 'DIMENSIONS'
9190 real(kind=8),dimension(2) :: V1,V2
9191 real(kind=8),dimension(2,2) :: A1
9192 real(kind=8) :: vaux1,vaux2
9196 ! 3 VI=VI+A1(I,K)*V1(K)
9200 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9201 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9205 end subroutine MATVEC2
9206 !-----------------------------------------------------------------------------
9207 subroutine MATMAT2(A1,A2,A3)
9209 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9211 ! implicit real*8 (a-h,o-z)
9212 ! include 'DIMENSIONS'
9213 real(kind=8),dimension(2,2) :: A1,A2,A3
9214 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
9215 ! DIMENSION AI3(2,2)
9219 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
9225 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9226 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9227 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9228 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9234 end subroutine MATMAT2
9235 !-----------------------------------------------------------------------------
9236 real(kind=8) function scalar2(u,v)
9237 !DIR$ INLINEALWAYS scalar2
9239 real(kind=8),dimension(2) :: u,v
9242 scalar2=u(1)*v(1)+u(2)*v(2)
9244 end function scalar2
9245 !-----------------------------------------------------------------------------
9246 subroutine transpose2(a,at)
9247 !DIR$ INLINEALWAYS transpose2
9249 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
9252 real(kind=8),dimension(2,2) :: a,at
9258 end subroutine transpose2
9259 !-----------------------------------------------------------------------------
9260 subroutine transpose(n,a,at)
9263 real(kind=8),dimension(n,n) :: a,at
9270 end subroutine transpose
9271 !-----------------------------------------------------------------------------
9272 subroutine prodmat3(a1,a2,kk,transp,prod)
9273 !DIR$ INLINEALWAYS prodmat3
9275 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
9279 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
9281 !rc double precision auxmat(2,2),prod_(2,2)
9284 !rc call transpose2(kk(1,1),auxmat(1,1))
9285 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9286 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9288 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
9289 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9290 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
9291 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9292 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
9293 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9294 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
9295 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9298 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9299 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9301 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
9302 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9303 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
9304 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9305 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
9306 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9307 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
9308 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9311 ! call transpose2(a2(1,1),a2t(1,1))
9314 !rc print *,((prod_(i,j),i=1,2),j=1,2)
9315 !rc print *,((prod(i,j),i=1,2),j=1,2)
9318 end subroutine prodmat3
9319 !-----------------------------------------------------------------------------
9320 ! energy_p_new_barrier.F
9321 !-----------------------------------------------------------------------------
9322 subroutine sum_gradient
9323 ! implicit real*8 (a-h,o-z)
9324 use io_base, only: pdbout
9325 ! include 'DIMENSIONS'
9329 !MS$ATTRIBUTES C :: proc_proc
9335 real(kind=8),dimension(3,nres) :: gradbufc,gradbufx,gradbufc_sum,&
9336 gloc_scbuf !(3,maxres)
9338 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
9341 integer :: i,j,k,ierror,ierr
9342 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
9343 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
9344 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
9345 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
9346 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
9347 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
9348 gsccorr_max,gsccorrx_max,time00
9350 ! include 'COMMON.SETUP'
9351 ! include 'COMMON.IOUNITS'
9352 ! include 'COMMON.FFIELD'
9353 ! include 'COMMON.DERIV'
9354 ! include 'COMMON.INTERACT'
9355 ! include 'COMMON.SBRIDGE'
9356 ! include 'COMMON.CHAIN'
9357 ! include 'COMMON.VAR'
9358 ! include 'COMMON.CONTROL'
9359 ! include 'COMMON.TIME1'
9360 ! include 'COMMON.MAXGRAD'
9361 ! include 'COMMON.SCCOR'
9366 write (iout,*) "sum_gradient gvdwc, gvdwx"
9368 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9369 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
9379 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
9380 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
9381 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
9384 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
9385 ! in virtual-bond-vector coordinates
9388 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
9390 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
9391 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
9393 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
9395 ! write (iout,'(i5,3f10.5,2x,f10.5)')
9396 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
9398 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
9400 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9401 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
9402 (gvdwc_scpp(j,i),j=1,3)
9404 write (iout,*) "gelc_long gvdwpp gel_loc_long"
9406 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
9407 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
9408 (gelc_loc_long(j,i),j=1,3)
9415 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
9416 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
9417 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
9418 wel_loc*gel_loc_long(j,i)+ &
9419 wcorr*gradcorr_long(j,i)+ &
9420 wcorr5*gradcorr5_long(j,i)+ &
9421 wcorr6*gradcorr6_long(j,i)+ &
9422 wturn6*gcorr6_turn_long(j,i)+ &
9429 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
9430 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
9431 welec*gelc_long(j,i)+ &
9433 wel_loc*gel_loc_long(j,i)+ &
9434 wcorr*gradcorr_long(j,i)+ &
9435 wcorr5*gradcorr5_long(j,i)+ &
9436 wcorr6*gradcorr6_long(j,i)+ &
9437 wturn6*gcorr6_turn_long(j,i)+ &
9443 if (nfgtasks.gt.1) then
9446 write (iout,*) "gradbufc before allreduce"
9448 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9454 gradbufc_sum(j,i)=gradbufc(j,i)
9457 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
9458 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
9459 ! time_reduce=time_reduce+MPI_Wtime()-time00
9461 ! write (iout,*) "gradbufc_sum after allreduce"
9463 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
9468 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
9476 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
9477 write (iout,*) (i," jgrad_start",jgrad_start(i),&
9478 " jgrad_end ",jgrad_end(i),&
9479 i=igrad_start,igrad_end)
9482 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
9483 ! do not parallelize this part.
9485 ! do i=igrad_start,igrad_end
9486 ! do j=jgrad_start(i),jgrad_end(i)
9488 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
9493 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
9497 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
9501 write (iout,*) "gradbufc after summing"
9503 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9511 write (iout,*) "gradbufc"
9513 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9520 gradbufc_sum(j,i)=gradbufc(j,i)
9525 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
9529 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
9534 ! gradbufc(k,i)=0.0d0
9538 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
9544 write (iout,*) "gradbufc after summing"
9546 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
9555 gradbufc(k,nres)=0.0d0
9558 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
9559 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
9560 !el-----------------
9564 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
9565 wel_loc*gel_loc(j,i)+ &
9566 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
9567 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
9568 wel_loc*gel_loc_long(j,i)+ &
9569 wcorr*gradcorr_long(j,i)+ &
9570 wcorr5*gradcorr5_long(j,i)+ &
9571 wcorr6*gradcorr6_long(j,i)+ &
9572 wturn6*gcorr6_turn_long(j,i))+ &
9574 wcorr*gradcorr(j,i)+ &
9575 wturn3*gcorr3_turn(j,i)+ &
9576 wturn4*gcorr4_turn(j,i)+ &
9577 wcorr5*gradcorr5(j,i)+ &
9578 wcorr6*gradcorr6(j,i)+ &
9579 wturn6*gcorr6_turn(j,i)+ &
9580 wsccor*gsccorc(j,i) &
9583 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
9584 wel_loc*gel_loc(j,i)+ &
9585 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
9586 welec*gelc_long(j,i)+ &
9587 wel_loc*gel_loc_long(j,i)+ &
9588 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
9589 wcorr5*gradcorr5_long(j,i)+ &
9590 wcorr6*gradcorr6_long(j,i)+ &
9591 wturn6*gcorr6_turn_long(j,i))+ &
9593 wcorr*gradcorr(j,i)+ &
9594 wturn3*gcorr3_turn(j,i)+ &
9595 wturn4*gcorr4_turn(j,i)+ &
9596 wcorr5*gradcorr5(j,i)+ &
9597 wcorr6*gradcorr6(j,i)+ &
9598 wturn6*gcorr6_turn(j,i)+ &
9599 wsccor*gsccorc(j,i) &
9602 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
9603 wbond*gradbx(j,i)+ &
9604 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
9605 wsccor*gsccorx(j,i) &
9606 +wscloc*gsclocx(j,i)
9610 write (iout,*) "gloc before adding corr"
9612 write (iout,*) i,gloc(i,icg)
9616 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
9617 +wcorr5*g_corr5_loc(i) &
9618 +wcorr6*g_corr6_loc(i) &
9619 +wturn4*gel_loc_turn4(i) &
9620 +wturn3*gel_loc_turn3(i) &
9621 +wturn6*gel_loc_turn6(i) &
9622 +wel_loc*gel_loc_loc(i)
9625 write (iout,*) "gloc after adding corr"
9627 write (iout,*) i,gloc(i,icg)
9631 if (nfgtasks.gt.1) then
9634 gradbufc(j,i)=gradc(j,i,icg)
9635 gradbufx(j,i)=gradx(j,i,icg)
9639 glocbuf(i)=gloc(i,icg)
9643 write (iout,*) "gloc_sc before reduce"
9646 write (iout,*) i,j,gloc_sc(j,i,icg)
9653 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
9657 call MPI_Barrier(FG_COMM,IERR)
9658 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
9660 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,&
9661 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9662 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,&
9663 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9664 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
9665 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9666 time_reduce=time_reduce+MPI_Wtime()-time00
9667 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
9668 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9669 time_reduce=time_reduce+MPI_Wtime()-time00
9672 write (iout,*) "gloc_sc after reduce"
9675 write (iout,*) i,j,gloc_sc(j,i,icg)
9681 write (iout,*) "gloc after reduce"
9683 write (iout,*) i,gloc(i,icg)
9688 if (gnorm_check) then
9690 ! Compute the maximum elements of the gradient
9700 gcorr3_turn_max=0.0d0
9701 gcorr4_turn_max=0.0d0
9704 gcorr6_turn_max=0.0d0
9714 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
9715 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
9716 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
9717 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
9718 gvdwc_scp_max=gvdwc_scp_norm
9719 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
9720 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
9721 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
9722 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
9723 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
9724 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
9725 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
9726 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
9727 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
9728 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
9729 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
9730 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
9731 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
9733 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
9734 gcorr3_turn_max=gcorr3_turn_norm
9735 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
9737 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
9738 gcorr4_turn_max=gcorr4_turn_norm
9739 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
9740 if (gradcorr5_norm.gt.gradcorr5_max) &
9741 gradcorr5_max=gradcorr5_norm
9742 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
9743 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
9744 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
9746 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
9747 gcorr6_turn_max=gcorr6_turn_norm
9748 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
9749 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
9750 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
9751 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
9752 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
9753 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
9754 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
9755 if (gradx_scp_norm.gt.gradx_scp_max) &
9756 gradx_scp_max=gradx_scp_norm
9757 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
9758 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
9759 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
9760 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
9761 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
9762 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
9763 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
9764 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
9768 open(istat,file=statname,position="append")
9770 open(istat,file=statname,access="append")
9772 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
9773 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
9774 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
9775 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
9776 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
9777 gsccorx_max,gsclocx_max
9779 if (gvdwc_max.gt.1.0d4) then
9780 write (iout,*) "gvdwc gvdwx gradb gradbx"
9782 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
9783 gradb(j,i),gradbx(j,i),j=1,3)
9785 call pdbout(0.0d0,'cipiszcze',iout)
9792 write (iout,*) "gradc gradx gloc"
9794 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
9795 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
9800 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
9803 end subroutine sum_gradient
9804 !-----------------------------------------------------------------------------
9806 ! implicit real*8 (a-h,o-z)
9808 ! include 'DIMENSIONS'
9809 ! include 'COMMON.CHAIN'
9810 ! include 'COMMON.DERIV'
9811 ! include 'COMMON.CALC'
9812 ! include 'COMMON.IOUNITS'
9813 real(kind=8), dimension(3) :: dcosom1,dcosom2
9815 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
9816 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
9817 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
9818 -2.0D0*alf12*eps3der+sigder*sigsq_om12
9822 ! eom12=evdwij*eps1_om12
9824 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
9826 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
9827 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
9828 !C print *,sss_ele_cut,'in sc_grad'
9830 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
9831 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
9834 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
9835 !C print *,'gg',k,gg(k)
9837 ! write (iout,*) "gg",(gg(k),k=1,3)
9839 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
9840 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
9841 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
9844 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
9845 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
9846 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
9849 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
9850 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
9851 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
9852 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
9855 ! Calculate the components of the gradient in DC and X
9859 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
9863 gvdwc(l,i)=gvdwc(l,i)-gg(l)
9864 gvdwc(l,j)=gvdwc(l,j)+gg(l)
9867 end subroutine sc_grad
9869 !-----------------------------------------------------------------------------
9870 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
9873 ! implicit real*8 (a-h,o-z)
9874 ! include 'DIMENSIONS'
9875 ! include 'COMMON.LOCAL'
9876 ! include 'COMMON.IOUNITS'
9877 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
9878 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
9879 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
9880 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
9881 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
9883 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
9884 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
9885 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
9888 delthec=thetai-thet_pred_mean
9889 delthe0=thetai-theta0i
9890 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
9891 t3 = thetai-thet_pred_mean
9895 t14 = t12+t6*sigsqtc
9897 t21 = thetai-theta0i
9903 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
9904 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
9905 *(-t12*t9-ak*sig0inv*t27)
9907 end subroutine mixder
9909 !-----------------------------------------------------------------------------
9911 !-----------------------------------------------------------------------------
9913 !-----------------------------------------------------------------------------
9914 ! This subroutine calculates the derivatives of the consecutive virtual
9915 ! bond vectors and the SC vectors in the virtual-bond angles theta and
9916 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
9917 ! in the angles alpha and omega, describing the location of a side chain
9918 ! in its local coordinate system.
9920 ! The derivatives are stored in the following arrays:
9922 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
9923 ! The structure is as follows:
9925 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
9926 ! 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)
9927 ! . . . . . . . . . . . . . . . . . .
9928 ! 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)
9932 ! 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)
9934 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
9935 ! The structure is same as above.
9937 ! DCDS - the derivatives of the side chain vectors in the local spherical
9938 ! andgles alph and omega:
9940 ! 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)
9941 ! 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)
9945 ! 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)
9947 ! Version of March '95, based on an early version of November '91.
9949 !**********************************************************************
9950 ! implicit real*8 (a-h,o-z)
9951 ! include 'DIMENSIONS'
9952 ! include 'COMMON.VAR'
9953 ! include 'COMMON.CHAIN'
9954 ! include 'COMMON.DERIV'
9955 ! include 'COMMON.GEO'
9956 ! include 'COMMON.LOCAL'
9957 ! include 'COMMON.INTERACT'
9958 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
9959 real(kind=8),dimension(3,3) :: dp,temp
9960 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
9961 real(kind=8),dimension(3) :: xx,xx1
9963 integer :: i,k,l,j,m,ind,ind1,jjj
9964 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
9965 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
9966 sint2,xp,yp,xxp,yyp,zzp,dj
9968 ! common /przechowalnia/ fromto
9969 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
9970 ! get the position of the jth ijth fragment of the chain coordinate system
9971 ! in the fromto array.
9972 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
9974 ! maxdim=(nres-1)*(nres-2)/2
9975 ! allocate(dcdv(6,maxdim),dxds(6,nres))
9976 ! calculate the derivatives of transformation matrix elements in theta
9979 !el call flush(iout) !el
9981 rdt(1,1,i)=-rt(1,2,i)
9982 rdt(1,2,i)= rt(1,1,i)
9984 rdt(2,1,i)=-rt(2,2,i)
9985 rdt(2,2,i)= rt(2,1,i)
9987 rdt(3,1,i)=-rt(3,2,i)
9988 rdt(3,2,i)= rt(3,1,i)
9992 ! derivatives in phi
9998 drt(2,1,i)= rt(3,1,i)
9999 drt(2,2,i)= rt(3,2,i)
10000 drt(2,3,i)= rt(3,3,i)
10001 drt(3,1,i)=-rt(2,1,i)
10002 drt(3,2,i)=-rt(2,2,i)
10003 drt(3,3,i)=-rt(2,3,i)
10006 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
10012 temp(k,l)=rt(k,l,i)
10017 fromto(k,l,ind)=temp(k,l)
10026 dpkl=dpkl+temp(k,m)*rt(m,l,j)
10029 fromto(k,l,ind)=dpkl
10040 ! Calculate derivatives.
10046 ! Derivatives of DC(i+1) in theta(i+2)
10052 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
10055 prordt(j,k,i)=dp(j,k)
10058 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
10061 ! Derivatives of SC(i+1) in theta(i+2)
10063 xx1(1)=-0.5D0*xloc(2,i+1)
10064 xx1(2)= 0.5D0*xloc(1,i+1)
10068 xj=xj+r(j,k,i)*xx1(k)
10075 rj=rj+prod(j,k,i)*xx(k)
10080 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
10081 ! than the other off-diagonal derivatives.
10086 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
10088 dxdv(j,ind1+1)=dxoiij
10090 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
10092 ! Derivatives of DC(i+1) in phi(i+2)
10098 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
10101 prodrt(j,k,i)=dp(j,k)
10103 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
10106 ! Derivatives of SC(i+1) in phi(i+2)
10109 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
10110 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
10114 rj=rj+prod(j,k,i)*xx(k)
10119 ! Derivatives of SC(i+1) in phi(i+3).
10124 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
10126 dxdv(j+3,ind1+1)=dxoiij
10129 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
10130 ! theta(nres) and phi(i+3) thru phi(nres).
10134 ind=indmat(i+1,j+1)
10135 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
10140 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
10145 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
10146 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
10147 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
10148 ! Derivatives of virtual-bond vectors in theta
10150 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
10152 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
10153 ! Derivatives of SC vectors in theta
10157 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
10159 dxdv(k,ind1+1)=dxoijk
10162 !--- Calculate the derivatives in phi
10168 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
10174 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
10179 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
10181 dxdv(k+3,ind1+1)=dxoijk
10186 ! Derivatives in alpha and omega:
10189 ! dsci=dsc(itype(i))
10194 if(alphi.ne.alphi) alphi=100.0
10195 if(omegi.ne.omegi) omegi=-100.0
10200 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
10201 cosalphi=dcos(alphi)
10202 sinalphi=dsin(alphi)
10203 cosomegi=dcos(omegi)
10204 sinomegi=dsin(omegi)
10205 temp(1,1)=-dsci*sinalphi
10206 temp(2,1)= dsci*cosalphi*cosomegi
10207 temp(3,1)=-dsci*cosalphi*sinomegi
10209 temp(2,2)=-dsci*sinalphi*sinomegi
10210 temp(3,2)=-dsci*sinalphi*cosomegi
10211 theta2=pi-0.5D0*theta(i+1)
10215 !d print *,((temp(l,k),l=1,3),k=1,2)
10219 xxp= xp*cost2+yp*sint2
10220 yyp=-xp*sint2+yp*cost2
10223 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
10224 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
10228 dj=dj+prod(k,l,i-1)*xx(l)
10236 end subroutine cartder
10237 !-----------------------------------------------------------------------------
10239 !-----------------------------------------------------------------------------
10240 subroutine check_cartgrad
10241 ! Check the gradient of Cartesian coordinates in internal coordinates.
10242 ! implicit real*8 (a-h,o-z)
10243 ! include 'DIMENSIONS'
10244 ! include 'COMMON.IOUNITS'
10245 ! include 'COMMON.VAR'
10246 ! include 'COMMON.CHAIN'
10247 ! include 'COMMON.GEO'
10248 ! include 'COMMON.LOCAL'
10249 ! include 'COMMON.DERIV'
10250 real(kind=8),dimension(6,nres) :: temp
10251 real(kind=8),dimension(3) :: xx,gg
10252 integer :: i,k,j,ii
10253 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
10254 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
10256 ! Check the gradient of the virtual-bond and SC vectors in the internal
10262 write (iout,'(a)') '**************** dx/dalpha'
10266 alph(i)=alph(i)+aincr
10268 temp(k,i)=dc(k,nres+i)
10272 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
10273 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
10275 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
10276 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
10282 write (iout,'(a)') '**************** dx/domega'
10286 omeg(i)=omeg(i)+aincr
10288 temp(k,i)=dc(k,nres+i)
10292 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
10293 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
10294 (aincr*dabs(dxds(k+3,i))+aincr))
10296 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
10297 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
10303 write (iout,'(a)') '**************** dx/dtheta'
10307 theta(i)=theta(i)+aincr
10310 temp(k,j)=dc(k,nres+j)
10316 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
10318 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
10319 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
10320 (aincr*dabs(dxdv(k,ii))+aincr))
10322 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10323 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
10330 write (iout,'(a)') '***************** dx/dphi'
10333 phi(i)=phi(i)+aincr
10336 temp(k,j)=dc(k,nres+j)
10344 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
10345 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
10346 (aincr*dabs(dxdv(k+3,ii))+aincr))
10348 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10349 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
10352 phi(i)=phi(i)-aincr
10355 write (iout,'(a)') '****************** ddc/dtheta'
10358 theta(i+2)=thet+aincr
10369 gg(k)=(dc(k,j)-temp(k,j))/aincr
10370 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
10371 (aincr*dabs(dcdv(k,ii))+aincr))
10373 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10374 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
10384 write (iout,'(a)') '******************* ddc/dphi'
10387 phi(i+3)=phii+aincr
10398 gg(k)=(dc(k,j)-temp(k,j))/aincr
10399 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
10400 (aincr*dabs(dcdv(k+3,ii))+aincr))
10402 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
10403 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
10414 end subroutine check_cartgrad
10415 !-----------------------------------------------------------------------------
10416 subroutine check_ecart
10417 ! Check the gradient of the energy in Cartesian coordinates.
10418 ! implicit real*8 (a-h,o-z)
10419 ! include 'DIMENSIONS'
10420 ! include 'COMMON.CHAIN'
10421 ! include 'COMMON.DERIV'
10422 ! include 'COMMON.IOUNITS'
10423 ! include 'COMMON.VAR'
10424 ! include 'COMMON.CONTACTS'
10426 !el integer :: icall
10427 !el common /srutu/ icall
10428 real(kind=8),dimension(6) :: ggg
10429 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
10430 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10431 real(kind=8),dimension(6,nres) :: grad_s
10432 real(kind=8),dimension(0:n_ene) :: energia,energia1
10433 integer :: uiparm(1)
10434 real(kind=8) :: urparm(1)
10436 integer :: nf,i,j,k
10437 real(kind=8) :: aincr,etot,etot1
10443 print '(a)','CG processor',me,' calling CHECK_CART.',aincr
10446 call geom_to_var(nvar,x)
10447 call etotal(energia)
10449 !el call enerprint(energia)
10450 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
10453 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10457 grad_s(j,i)=gradc(j,i,icg)
10458 grad_s(j+3,i)=gradx(j,i,icg)
10462 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10467 ddx(j)=dc(j,i+nres)
10470 dc(j,i)=dc(j,i)+aincr
10472 c(j,k)=c(j,k)+aincr
10473 c(j,k+nres)=c(j,k+nres)+aincr
10475 call etotal(energia1)
10477 ggg(j)=(etot1-etot)/aincr
10480 c(j,k)=c(j,k)-aincr
10481 c(j,k+nres)=c(j,k+nres)-aincr
10485 c(j,i+nres)=c(j,i+nres)+aincr
10486 dc(j,i+nres)=dc(j,i+nres)+aincr
10487 call etotal(energia1)
10489 ggg(j+3)=(etot1-etot)/aincr
10491 dc(j,i+nres)=ddx(j)
10493 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
10494 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
10497 end subroutine check_ecart
10499 !-----------------------------------------------------------------------------
10500 subroutine check_ecartint
10501 ! Check the gradient of the energy in Cartesian coordinates.
10502 use io_base, only: intout
10503 ! implicit real*8 (a-h,o-z)
10504 ! include 'DIMENSIONS'
10505 ! include 'COMMON.CONTROL'
10506 ! include 'COMMON.CHAIN'
10507 ! include 'COMMON.DERIV'
10508 ! include 'COMMON.IOUNITS'
10509 ! include 'COMMON.VAR'
10510 ! include 'COMMON.CONTACTS'
10511 ! include 'COMMON.MD'
10512 ! include 'COMMON.LOCAL'
10513 ! include 'COMMON.SPLITELE'
10515 !el integer :: icall
10516 !el common /srutu/ icall
10517 real(kind=8),dimension(6) :: ggg,ggg1
10518 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
10519 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10520 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
10521 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
10522 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
10523 real(kind=8),dimension(0:n_ene) :: energia,energia1
10524 integer :: uiparm(1)
10525 real(kind=8) :: urparm(1)
10527 integer :: i,j,k,nf
10528 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
10536 ! call intcartderiv
10537 ! call checkintcartgrad
10540 write(iout,*) 'Calling CHECK_ECARTINT.'
10543 write (iout,*) "Before geom_to_var"
10544 call geom_to_var(nvar,x)
10545 write (iout,*) "after geom_to_var"
10546 write (iout,*) "split_ene ",split_ene
10548 if (.not.split_ene) then
10549 write(iout,*) 'Calling CHECK_ECARTINT if'
10550 call etotal(energia)
10551 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
10553 write (iout,*) "etot",etot
10555 !el call enerprint(energia)
10556 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
10558 write (iout,*) "enter cartgrad"
10561 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
10562 write (iout,*) "exit cartgrad"
10566 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10569 grad_s(j,0)=gcart(j,0)
10571 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
10574 grad_s(j,i)=gcart(j,i)
10575 grad_s(j+3,i)=gxcart(j,i)
10579 write(iout,*) 'Calling CHECK_ECARTIN else.'
10580 !- split gradient check
10582 call etotal_long(energia)
10583 !el call enerprint(energia)
10585 write (iout,*) "enter cartgrad"
10588 write (iout,*) "exit cartgrad"
10591 write (iout,*) "longrange grad"
10593 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10594 (gxcart(j,i),j=1,3)
10597 grad_s(j,0)=gcart(j,0)
10601 grad_s(j,i)=gcart(j,i)
10602 grad_s(j+3,i)=gxcart(j,i)
10606 call etotal_short(energia)
10607 !el call enerprint(energia)
10609 write (iout,*) "enter cartgrad"
10612 write (iout,*) "exit cartgrad"
10615 write (iout,*) "shortrange grad"
10617 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10618 (gxcart(j,i),j=1,3)
10621 grad_s1(j,0)=gcart(j,0)
10625 grad_s1(j,i)=gcart(j,i)
10626 grad_s1(j+3,i)=gxcart(j,i)
10630 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10634 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
10635 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
10638 dcnorm_safe1(j)=dc_norm(j,i-1)
10639 dcnorm_safe2(j)=dc_norm(j,i)
10640 dxnorm_safe(j)=dc_norm(j,i+nres)
10643 c(j,i)=ddc(j)+aincr
10644 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
10645 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
10646 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
10647 dc(j,i)=c(j,i+1)-c(j,i)
10648 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10649 call int_from_cart1(.false.)
10650 if (.not.split_ene) then
10651 call etotal(energia1)
10653 write (iout,*) "ij",i,j," etot1",etot1
10656 call etotal_long(energia1)
10658 call etotal_short(energia1)
10661 !- end split gradient
10662 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10663 c(j,i)=ddc(j)-aincr
10664 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
10665 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
10666 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
10667 dc(j,i)=c(j,i+1)-c(j,i)
10668 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10669 call int_from_cart1(.false.)
10670 if (.not.split_ene) then
10671 call etotal(energia1)
10673 write (iout,*) "ij",i,j," etot2",etot2
10674 ggg(j)=(etot1-etot2)/(2*aincr)
10677 call etotal_long(energia1)
10679 ggg(j)=(etot11-etot21)/(2*aincr)
10680 call etotal_short(energia1)
10682 ggg1(j)=(etot12-etot22)/(2*aincr)
10683 !- end split gradient
10684 ! write (iout,*) "etot21",etot21," etot22",etot22
10686 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10688 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
10689 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
10690 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
10691 dc(j,i)=c(j,i+1)-c(j,i)
10692 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10693 dc_norm(j,i-1)=dcnorm_safe1(j)
10694 dc_norm(j,i)=dcnorm_safe2(j)
10695 dc_norm(j,i+nres)=dxnorm_safe(j)
10698 c(j,i+nres)=ddx(j)+aincr
10699 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10700 call int_from_cart1(.false.)
10701 if (.not.split_ene) then
10702 call etotal(energia1)
10706 call etotal_long(energia1)
10708 call etotal_short(energia1)
10711 !- end split gradient
10712 c(j,i+nres)=ddx(j)-aincr
10713 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10714 call int_from_cart1(.false.)
10715 if (.not.split_ene) then
10716 call etotal(energia1)
10718 ggg(j+3)=(etot1-etot2)/(2*aincr)
10721 call etotal_long(energia1)
10723 ggg(j+3)=(etot11-etot21)/(2*aincr)
10724 call etotal_short(energia1)
10726 ggg1(j+3)=(etot12-etot22)/(2*aincr)
10727 !- end split gradient
10729 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10731 dc(j,i+nres)=c(j,i+nres)-c(j,i)
10732 dc_norm(j,i+nres)=dxnorm_safe(j)
10733 call int_from_cart1(.false.)
10735 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10736 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
10737 if (split_ene) then
10738 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10739 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
10741 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10742 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
10743 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
10747 end subroutine check_ecartint
10749 !-----------------------------------------------------------------------------
10750 subroutine check_ecartint
10751 ! Check the gradient of the energy in Cartesian coordinates.
10752 use io_base, only: intout
10753 ! implicit real*8 (a-h,o-z)
10754 ! include 'DIMENSIONS'
10755 ! include 'COMMON.CONTROL'
10756 ! include 'COMMON.CHAIN'
10757 ! include 'COMMON.DERIV'
10758 ! include 'COMMON.IOUNITS'
10759 ! include 'COMMON.VAR'
10760 ! include 'COMMON.CONTACTS'
10761 ! include 'COMMON.MD'
10762 ! include 'COMMON.LOCAL'
10763 ! include 'COMMON.SPLITELE'
10765 !el integer :: icall
10766 !el common /srutu/ icall
10767 real(kind=8),dimension(6) :: ggg,ggg1
10768 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
10769 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
10770 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
10771 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
10772 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
10773 real(kind=8),dimension(0:n_ene) :: energia,energia1
10774 integer :: uiparm(1)
10775 real(kind=8) :: urparm(1)
10777 integer :: i,j,k,nf
10778 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
10786 ! call intcartderiv
10787 ! call checkintcartgrad
10790 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
10793 call geom_to_var(nvar,x)
10794 if (.not.split_ene) then
10795 call etotal(energia)
10797 !el call enerprint(energia)
10799 write (iout,*) "enter cartgrad"
10802 write (iout,*) "exit cartgrad"
10806 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
10809 grad_s(j,0)=gcart(j,0)
10813 grad_s(j,i)=gcart(j,i)
10814 grad_s(j+3,i)=gxcart(j,i)
10818 !- split gradient check
10820 call etotal_long(energia)
10821 !el call enerprint(energia)
10823 write (iout,*) "enter cartgrad"
10826 write (iout,*) "exit cartgrad"
10829 write (iout,*) "longrange grad"
10831 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10832 (gxcart(j,i),j=1,3)
10835 grad_s(j,0)=gcart(j,0)
10839 grad_s(j,i)=gcart(j,i)
10840 grad_s(j+3,i)=gxcart(j,i)
10844 call etotal_short(energia)
10845 !el call enerprint(energia)
10847 write (iout,*) "enter cartgrad"
10850 write (iout,*) "exit cartgrad"
10853 write (iout,*) "shortrange grad"
10855 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
10856 (gxcart(j,i),j=1,3)
10859 grad_s1(j,0)=gcart(j,0)
10863 grad_s1(j,i)=gcart(j,i)
10864 grad_s1(j+3,i)=gxcart(j,i)
10868 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
10873 ddx(j)=dc(j,i+nres)
10875 dcnorm_safe(k)=dc_norm(k,i)
10876 dxnorm_safe(k)=dc_norm(k,i+nres)
10880 dc(j,i)=ddc(j)+aincr
10881 call chainbuild_cart
10883 ! Broadcast the order to compute internal coordinates to the slaves.
10884 ! if (nfgtasks.gt.1)
10885 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
10887 ! call int_from_cart1(.false.)
10888 if (.not.split_ene) then
10889 call etotal(energia1)
10893 call etotal_long(energia1)
10895 call etotal_short(energia1)
10897 ! write (iout,*) "etot11",etot11," etot12",etot12
10899 !- end split gradient
10900 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10901 dc(j,i)=ddc(j)-aincr
10902 call chainbuild_cart
10903 ! call int_from_cart1(.false.)
10904 if (.not.split_ene) then
10905 call etotal(energia1)
10907 ggg(j)=(etot1-etot2)/(2*aincr)
10910 call etotal_long(energia1)
10912 ggg(j)=(etot11-etot21)/(2*aincr)
10913 call etotal_short(energia1)
10915 ggg1(j)=(etot12-etot22)/(2*aincr)
10916 !- end split gradient
10917 ! write (iout,*) "etot21",etot21," etot22",etot22
10919 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10921 call chainbuild_cart
10924 dc(j,i+nres)=ddx(j)+aincr
10925 call chainbuild_cart
10926 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
10927 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
10928 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
10929 ! write (iout,*) "dxnormnorm",dsqrt(
10930 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
10931 ! write (iout,*) "dxnormnormsafe",dsqrt(
10932 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
10934 if (.not.split_ene) then
10935 call etotal(energia1)
10939 call etotal_long(energia1)
10941 call etotal_short(energia1)
10944 !- end split gradient
10945 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
10946 dc(j,i+nres)=ddx(j)-aincr
10947 call chainbuild_cart
10948 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
10949 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
10950 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
10952 ! write (iout,*) "dxnormnorm",dsqrt(
10953 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
10954 ! write (iout,*) "dxnormnormsafe",dsqrt(
10955 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
10956 if (.not.split_ene) then
10957 call etotal(energia1)
10959 ggg(j+3)=(etot1-etot2)/(2*aincr)
10962 call etotal_long(energia1)
10964 ggg(j+3)=(etot11-etot21)/(2*aincr)
10965 call etotal_short(energia1)
10967 ggg1(j+3)=(etot12-etot22)/(2*aincr)
10968 !- end split gradient
10970 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
10971 dc(j,i+nres)=ddx(j)
10972 call chainbuild_cart
10974 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10975 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
10976 if (split_ene) then
10977 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10978 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
10980 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
10981 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
10982 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
10986 end subroutine check_ecartint
10988 !-----------------------------------------------------------------------------
10989 subroutine check_eint
10990 ! Check the gradient of energy in internal coordinates.
10991 ! implicit real*8 (a-h,o-z)
10992 ! include 'DIMENSIONS'
10993 ! include 'COMMON.CHAIN'
10994 ! include 'COMMON.DERIV'
10995 ! include 'COMMON.IOUNITS'
10996 ! include 'COMMON.VAR'
10997 ! include 'COMMON.GEO'
10999 !el integer :: icall
11000 !el common /srutu/ icall
11001 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
11002 integer :: uiparm(1)
11003 real(kind=8) :: urparm(1)
11004 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
11005 character(len=6) :: key
11008 real(kind=8) :: xi,aincr,etot,etot1,etot2
11011 print '(a)','Calling CHECK_INT.'
11015 call geom_to_var(nvar,x)
11016 call var_to_geom(nvar,x)
11020 call etotal(energia)
11022 !el call enerprint(energia)
11025 if (MyID.ne.BossID) then
11026 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
11034 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
11035 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
11036 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
11040 x(i)=xi-0.5D0*aincr
11041 call var_to_geom(nvar,x)
11043 call etotal(energia1)
11045 x(i)=xi+0.5D0*aincr
11046 call var_to_geom(nvar,x)
11048 call etotal(energia2)
11050 gg(i)=(etot2-etot1)/aincr
11051 write (iout,*) i,etot1,etot2
11054 write (iout,'(/2a)')' Variable Numerical Analytical',&
11057 if (i.le.nphi) then
11060 else if (i.le.nphi+ntheta) then
11063 else if (i.le.nphi+ntheta+nside) then
11067 ii=i-(nphi+ntheta+nside)
11070 write (iout,'(i3,a,i3,3(1pd16.6))') &
11071 i,key,ii,gg(i),gana(i),&
11072 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
11075 end subroutine check_eint
11076 !-----------------------------------------------------------------------------
11078 !-----------------------------------------------------------------------------
11079 subroutine Econstr_back
11080 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
11081 ! implicit real*8 (a-h,o-z)
11082 ! include 'DIMENSIONS'
11083 ! include 'COMMON.CONTROL'
11084 ! include 'COMMON.VAR'
11085 ! include 'COMMON.MD'
11088 ! include 'COMMON.LANGEVIN'
11090 ! include 'COMMON.LANGEVIN.lang0'
11092 ! include 'COMMON.CHAIN'
11093 ! include 'COMMON.DERIV'
11094 ! include 'COMMON.GEO'
11095 ! include 'COMMON.LOCAL'
11096 ! include 'COMMON.INTERACT'
11097 ! include 'COMMON.IOUNITS'
11098 ! include 'COMMON.NAMES'
11099 ! include 'COMMON.TIME1'
11100 integer :: i,j,ii,k
11101 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
11103 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
11104 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
11105 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
11112 duscdiff(j,i)=0.0d0
11113 duscdiffx(j,i)=0.0d0
11117 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
11119 ! Deviations from theta angles
11122 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
11123 dtheta_i=theta(j)-thetaref(j)
11124 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
11125 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
11127 utheta(i)=utheta_i/(ii-1)
11129 ! Deviations from gamma angles
11132 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
11133 dgamma_i=pinorm(phi(j)-phiref(j))
11134 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
11135 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
11136 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
11137 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
11139 ugamma(i)=ugamma_i/(ii-2)
11141 ! Deviations from local SC geometry
11144 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
11145 dxx=xxtab(j)-xxref(j)
11146 dyy=yytab(j)-yyref(j)
11147 dzz=zztab(j)-zzref(j)
11148 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
11150 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
11151 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
11153 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
11154 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
11156 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
11157 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
11160 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
11161 ! & xxref(j),yyref(j),zzref(j)
11163 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
11164 ! write (iout,*) i," uscdiff",uscdiff(i)
11166 ! Put together deviations from local geometry
11168 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
11169 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
11170 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
11171 ! & " uconst_back",uconst_back
11172 utheta(i)=dsqrt(utheta(i))
11173 ugamma(i)=dsqrt(ugamma(i))
11174 uscdiff(i)=dsqrt(uscdiff(i))
11177 end subroutine Econstr_back
11178 !-----------------------------------------------------------------------------
11179 ! energy_p_new-sep_barrier.F
11180 !-----------------------------------------------------------------------------
11181 real(kind=8) function sscale(r)
11182 ! include "COMMON.SPLITELE"
11183 real(kind=8) :: r,gamm
11184 if(r.lt.r_cut-rlamb) then
11186 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
11187 gamm=(r-(r_cut-rlamb))/rlamb
11188 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
11193 end function sscale
11194 real(kind=8) function sscale_grad(r)
11195 ! include "COMMON.SPLITELE"
11196 real(kind=8) :: r,gamm
11197 if(r.lt.r_cut-rlamb) then
11199 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
11200 gamm=(r-(r_cut-rlamb))/rlamb
11201 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
11206 end function sscale_grad
11208 !!!!!!!!!! PBCSCALE
11209 real(kind=8) function sscale_ele(r)
11210 ! include "COMMON.SPLITELE"
11211 real(kind=8) :: r,gamm
11212 if(r.lt.r_cut_ele-rlamb_ele) then
11214 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
11215 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
11216 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
11221 end function sscale_ele
11223 real(kind=8) function sscagrad_ele(r)
11224 real(kind=8) :: r,gamm
11225 ! include "COMMON.SPLITELE"
11226 if(r.lt.r_cut_ele-rlamb_ele) then
11228 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
11229 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
11230 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
11235 end function sscagrad_ele
11237 !-----------------------------------------------------------------------------
11238 subroutine elj_long(evdw)
11240 ! This subroutine calculates the interaction energy of nonbonded side chains
11241 ! assuming the LJ potential of interaction.
11243 ! implicit real*8 (a-h,o-z)
11244 ! include 'DIMENSIONS'
11245 ! include 'COMMON.GEO'
11246 ! include 'COMMON.VAR'
11247 ! include 'COMMON.LOCAL'
11248 ! include 'COMMON.CHAIN'
11249 ! include 'COMMON.DERIV'
11250 ! include 'COMMON.INTERACT'
11251 ! include 'COMMON.TORSION'
11252 ! include 'COMMON.SBRIDGE'
11253 ! include 'COMMON.NAMES'
11254 ! include 'COMMON.IOUNITS'
11255 ! include 'COMMON.CONTACTS'
11256 real(kind=8),parameter :: accur=1.0d-10
11257 real(kind=8),dimension(3) :: gg
11258 !el local variables
11259 integer :: i,iint,j,k,itypi,itypi1,itypj
11260 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
11261 real(kind=8) :: e1,e2,evdwij,evdw
11262 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
11264 do i=iatsc_s,iatsc_e
11266 if (itypi.eq.ntyp1) cycle
11272 ! Calculate SC interaction energy.
11274 do iint=1,nint_gr(i)
11275 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
11276 !d & 'iend=',iend(i,iint)
11277 do j=istart(i,iint),iend(i,iint)
11279 if (itypj.eq.ntyp1) cycle
11283 rij=xj*xj+yj*yj+zj*zj
11284 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
11285 if (sss.lt.1.0d0) then
11287 eps0ij=eps(itypi,itypj)
11289 e1=fac*fac*aa(itypi,itypj)
11290 e2=fac*bb(itypi,itypj)
11292 evdw=evdw+(1.0d0-sss)*evdwij
11294 ! Calculate the components of the gradient in DC and X
11296 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
11301 gvdwx(k,i)=gvdwx(k,i)-gg(k)
11302 gvdwx(k,j)=gvdwx(k,j)+gg(k)
11303 gvdwc(k,i)=gvdwc(k,i)-gg(k)
11304 gvdwc(k,j)=gvdwc(k,j)+gg(k)
11312 gvdwc(j,i)=expon*gvdwc(j,i)
11313 gvdwx(j,i)=expon*gvdwx(j,i)
11316 !******************************************************************************
11320 ! To save time, the factor of EXPON has been extracted from ALL components
11321 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
11324 !******************************************************************************
11326 end subroutine elj_long
11327 !-----------------------------------------------------------------------------
11328 subroutine elj_short(evdw)
11330 ! This subroutine calculates the interaction energy of nonbonded side chains
11331 ! assuming the LJ potential of interaction.
11333 ! implicit real*8 (a-h,o-z)
11334 ! include 'DIMENSIONS'
11335 ! include 'COMMON.GEO'
11336 ! include 'COMMON.VAR'
11337 ! include 'COMMON.LOCAL'
11338 ! include 'COMMON.CHAIN'
11339 ! include 'COMMON.DERIV'
11340 ! include 'COMMON.INTERACT'
11341 ! include 'COMMON.TORSION'
11342 ! include 'COMMON.SBRIDGE'
11343 ! include 'COMMON.NAMES'
11344 ! include 'COMMON.IOUNITS'
11345 ! include 'COMMON.CONTACTS'
11346 real(kind=8),parameter :: accur=1.0d-10
11347 real(kind=8),dimension(3) :: gg
11348 !el local variables
11349 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
11350 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
11351 real(kind=8) :: e1,e2,evdwij,evdw
11352 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
11354 do i=iatsc_s,iatsc_e
11356 if (itypi.eq.ntyp1) cycle
11364 ! Calculate SC interaction energy.
11366 do iint=1,nint_gr(i)
11367 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
11368 !d & 'iend=',iend(i,iint)
11369 do j=istart(i,iint),iend(i,iint)
11371 if (itypj.eq.ntyp1) cycle
11375 ! Change 12/1/95 to calculate four-body interactions
11376 rij=xj*xj+yj*yj+zj*zj
11377 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
11378 if (sss.gt.0.0d0) then
11380 eps0ij=eps(itypi,itypj)
11382 e1=fac*fac*aa(itypi,itypj)
11383 e2=fac*bb(itypi,itypj)
11385 evdw=evdw+sss*evdwij
11387 ! Calculate the components of the gradient in DC and X
11389 fac=-rrij*(e1+evdwij)*sss
11394 gvdwx(k,i)=gvdwx(k,i)-gg(k)
11395 gvdwx(k,j)=gvdwx(k,j)+gg(k)
11396 gvdwc(k,i)=gvdwc(k,i)-gg(k)
11397 gvdwc(k,j)=gvdwc(k,j)+gg(k)
11405 gvdwc(j,i)=expon*gvdwc(j,i)
11406 gvdwx(j,i)=expon*gvdwx(j,i)
11409 !******************************************************************************
11413 ! To save time, the factor of EXPON has been extracted from ALL components
11414 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
11417 !******************************************************************************
11419 end subroutine elj_short
11420 !-----------------------------------------------------------------------------
11421 subroutine eljk_long(evdw)
11423 ! This subroutine calculates the interaction energy of nonbonded side chains
11424 ! assuming the LJK potential of interaction.
11426 ! implicit real*8 (a-h,o-z)
11427 ! include 'DIMENSIONS'
11428 ! include 'COMMON.GEO'
11429 ! include 'COMMON.VAR'
11430 ! include 'COMMON.LOCAL'
11431 ! include 'COMMON.CHAIN'
11432 ! include 'COMMON.DERIV'
11433 ! include 'COMMON.INTERACT'
11434 ! include 'COMMON.IOUNITS'
11435 ! include 'COMMON.NAMES'
11436 real(kind=8),dimension(3) :: gg
11438 !el local variables
11439 integer :: i,iint,j,k,itypi,itypi1,itypj
11440 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
11441 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
11442 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
11444 do i=iatsc_s,iatsc_e
11446 if (itypi.eq.ntyp1) cycle
11452 ! Calculate SC interaction energy.
11454 do iint=1,nint_gr(i)
11455 do j=istart(i,iint),iend(i,iint)
11457 if (itypj.eq.ntyp1) cycle
11461 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11462 fac_augm=rrij**expon
11463 e_augm=augm(itypi,itypj)*fac_augm
11464 r_inv_ij=dsqrt(rrij)
11466 sss=sscale(rij/sigma(itypi,itypj))
11467 if (sss.lt.1.0d0) then
11468 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
11469 fac=r_shift_inv**expon
11470 e1=fac*fac*aa(itypi,itypj)
11471 e2=fac*bb(itypi,itypj)
11472 evdwij=e_augm+e1+e2
11473 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11474 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11475 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
11476 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
11477 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
11478 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
11479 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
11480 evdw=evdw+(1.0d0-sss)*evdwij
11482 ! Calculate the components of the gradient in DC and X
11484 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
11485 fac=fac*(1.0d0-sss)
11490 gvdwx(k,i)=gvdwx(k,i)-gg(k)
11491 gvdwx(k,j)=gvdwx(k,j)+gg(k)
11492 gvdwc(k,i)=gvdwc(k,i)-gg(k)
11493 gvdwc(k,j)=gvdwc(k,j)+gg(k)
11501 gvdwc(j,i)=expon*gvdwc(j,i)
11502 gvdwx(j,i)=expon*gvdwx(j,i)
11506 end subroutine eljk_long
11507 !-----------------------------------------------------------------------------
11508 subroutine eljk_short(evdw)
11510 ! This subroutine calculates the interaction energy of nonbonded side chains
11511 ! assuming the LJK potential of interaction.
11513 ! implicit real*8 (a-h,o-z)
11514 ! include 'DIMENSIONS'
11515 ! include 'COMMON.GEO'
11516 ! include 'COMMON.VAR'
11517 ! include 'COMMON.LOCAL'
11518 ! include 'COMMON.CHAIN'
11519 ! include 'COMMON.DERIV'
11520 ! include 'COMMON.INTERACT'
11521 ! include 'COMMON.IOUNITS'
11522 ! include 'COMMON.NAMES'
11523 real(kind=8),dimension(3) :: gg
11525 !el local variables
11526 integer :: i,iint,j,k,itypi,itypi1,itypj
11527 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
11528 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
11529 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
11531 do i=iatsc_s,iatsc_e
11533 if (itypi.eq.ntyp1) cycle
11539 ! Calculate SC interaction energy.
11541 do iint=1,nint_gr(i)
11542 do j=istart(i,iint),iend(i,iint)
11544 if (itypj.eq.ntyp1) cycle
11548 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11549 fac_augm=rrij**expon
11550 e_augm=augm(itypi,itypj)*fac_augm
11551 r_inv_ij=dsqrt(rrij)
11553 sss=sscale(rij/sigma(itypi,itypj))
11554 if (sss.gt.0.0d0) then
11555 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
11556 fac=r_shift_inv**expon
11557 e1=fac*fac*aa(itypi,itypj)
11558 e2=fac*bb(itypi,itypj)
11559 evdwij=e_augm+e1+e2
11560 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11561 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11562 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
11563 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
11564 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
11565 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
11566 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
11567 evdw=evdw+sss*evdwij
11569 ! Calculate the components of the gradient in DC and X
11571 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
11577 gvdwx(k,i)=gvdwx(k,i)-gg(k)
11578 gvdwx(k,j)=gvdwx(k,j)+gg(k)
11579 gvdwc(k,i)=gvdwc(k,i)-gg(k)
11580 gvdwc(k,j)=gvdwc(k,j)+gg(k)
11588 gvdwc(j,i)=expon*gvdwc(j,i)
11589 gvdwx(j,i)=expon*gvdwx(j,i)
11593 end subroutine eljk_short
11594 !-----------------------------------------------------------------------------
11595 subroutine ebp_long(evdw)
11597 ! This subroutine calculates the interaction energy of nonbonded side chains
11598 ! assuming the Berne-Pechukas potential of interaction.
11601 ! implicit real*8 (a-h,o-z)
11602 ! include 'DIMENSIONS'
11603 ! include 'COMMON.GEO'
11604 ! include 'COMMON.VAR'
11605 ! include 'COMMON.LOCAL'
11606 ! include 'COMMON.CHAIN'
11607 ! include 'COMMON.DERIV'
11608 ! include 'COMMON.NAMES'
11609 ! include 'COMMON.INTERACT'
11610 ! include 'COMMON.IOUNITS'
11611 ! include 'COMMON.CALC'
11613 !el integer :: icall
11614 !el common /srutu/ icall
11615 ! double precision rrsave(maxdim)
11617 !el local variables
11618 integer :: iint,itypi,itypi1,itypj
11619 real(kind=8) :: rrij,xi,yi,zi,fac
11620 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
11622 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
11624 ! if (icall.eq.0) then
11630 do i=iatsc_s,iatsc_e
11632 if (itypi.eq.ntyp1) cycle
11637 dxi=dc_norm(1,nres+i)
11638 dyi=dc_norm(2,nres+i)
11639 dzi=dc_norm(3,nres+i)
11640 ! dsci_inv=dsc_inv(itypi)
11641 dsci_inv=vbld_inv(i+nres)
11643 ! Calculate SC interaction energy.
11645 do iint=1,nint_gr(i)
11646 do j=istart(i,iint),iend(i,iint)
11649 if (itypj.eq.ntyp1) cycle
11650 ! dscj_inv=dsc_inv(itypj)
11651 dscj_inv=vbld_inv(j+nres)
11652 chi1=chi(itypi,itypj)
11653 chi2=chi(itypj,itypi)
11660 alf12=0.5D0*(alf1+alf2)
11664 dxj=dc_norm(1,nres+j)
11665 dyj=dc_norm(2,nres+j)
11666 dzj=dc_norm(3,nres+j)
11667 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11669 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11671 if (sss.lt.1.0d0) then
11673 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
11675 ! Calculate whole angle-dependent part of epsilon and contributions
11676 ! to its derivatives
11677 fac=(rrij*sigsq)**expon2
11678 e1=fac*fac*aa(itypi,itypj)
11679 e2=fac*bb(itypi,itypj)
11680 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11681 eps2der=evdwij*eps3rt
11682 eps3der=evdwij*eps2rt
11683 evdwij=evdwij*eps2rt*eps3rt
11684 evdw=evdw+evdwij*(1.0d0-sss)
11686 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11687 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11688 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
11689 !d & restyp(itypi),i,restyp(itypj),j,
11690 !d & epsi,sigm,chi1,chi2,chip1,chip2,
11691 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
11692 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
11695 ! Calculate gradient components.
11696 e1=e1*eps1*eps2rt**2*eps3rt**2
11697 fac=-expon*(e1+evdwij)
11700 ! Calculate radial part of the gradient
11704 ! Calculate the angular part of the gradient and sum add the contributions
11705 ! to the appropriate components of the Cartesian gradient.
11706 call sc_grad_scale(1.0d0-sss)
11713 end subroutine ebp_long
11714 !-----------------------------------------------------------------------------
11715 subroutine ebp_short(evdw)
11717 ! This subroutine calculates the interaction energy of nonbonded side chains
11718 ! assuming the Berne-Pechukas potential of interaction.
11721 ! implicit real*8 (a-h,o-z)
11722 ! include 'DIMENSIONS'
11723 ! include 'COMMON.GEO'
11724 ! include 'COMMON.VAR'
11725 ! include 'COMMON.LOCAL'
11726 ! include 'COMMON.CHAIN'
11727 ! include 'COMMON.DERIV'
11728 ! include 'COMMON.NAMES'
11729 ! include 'COMMON.INTERACT'
11730 ! include 'COMMON.IOUNITS'
11731 ! include 'COMMON.CALC'
11733 !el integer :: icall
11734 !el common /srutu/ icall
11735 ! double precision rrsave(maxdim)
11737 !el local variables
11738 integer :: iint,itypi,itypi1,itypj
11739 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
11740 real(kind=8) :: sss,e1,e2,evdw
11742 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
11744 ! if (icall.eq.0) then
11750 do i=iatsc_s,iatsc_e
11752 if (itypi.eq.ntyp1) cycle
11757 dxi=dc_norm(1,nres+i)
11758 dyi=dc_norm(2,nres+i)
11759 dzi=dc_norm(3,nres+i)
11760 ! dsci_inv=dsc_inv(itypi)
11761 dsci_inv=vbld_inv(i+nres)
11763 ! Calculate SC interaction energy.
11765 do iint=1,nint_gr(i)
11766 do j=istart(i,iint),iend(i,iint)
11769 if (itypj.eq.ntyp1) cycle
11770 ! dscj_inv=dsc_inv(itypj)
11771 dscj_inv=vbld_inv(j+nres)
11772 chi1=chi(itypi,itypj)
11773 chi2=chi(itypj,itypi)
11780 alf12=0.5D0*(alf1+alf2)
11784 dxj=dc_norm(1,nres+j)
11785 dyj=dc_norm(2,nres+j)
11786 dzj=dc_norm(3,nres+j)
11787 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11789 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11791 if (sss.gt.0.0d0) then
11793 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
11795 ! Calculate whole angle-dependent part of epsilon and contributions
11796 ! to its derivatives
11797 fac=(rrij*sigsq)**expon2
11798 e1=fac*fac*aa(itypi,itypj)
11799 e2=fac*bb(itypi,itypj)
11800 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11801 eps2der=evdwij*eps3rt
11802 eps3der=evdwij*eps2rt
11803 evdwij=evdwij*eps2rt*eps3rt
11804 evdw=evdw+evdwij*sss
11806 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11807 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11808 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
11809 !d & restyp(itypi),i,restyp(itypj),j,
11810 !d & epsi,sigm,chi1,chi2,chip1,chip2,
11811 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
11812 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
11815 ! Calculate gradient components.
11816 e1=e1*eps1*eps2rt**2*eps3rt**2
11817 fac=-expon*(e1+evdwij)
11820 ! Calculate radial part of the gradient
11824 ! Calculate the angular part of the gradient and sum add the contributions
11825 ! to the appropriate components of the Cartesian gradient.
11826 call sc_grad_scale(sss)
11833 end subroutine ebp_short
11834 !-----------------------------------------------------------------------------
11835 subroutine egb_long(evdw)
11837 ! This subroutine calculates the interaction energy of nonbonded side chains
11838 ! assuming the Gay-Berne potential of interaction.
11841 ! implicit real*8 (a-h,o-z)
11842 ! include 'DIMENSIONS'
11843 ! include 'COMMON.GEO'
11844 ! include 'COMMON.VAR'
11845 ! include 'COMMON.LOCAL'
11846 ! include 'COMMON.CHAIN'
11847 ! include 'COMMON.DERIV'
11848 ! include 'COMMON.NAMES'
11849 ! include 'COMMON.INTERACT'
11850 ! include 'COMMON.IOUNITS'
11851 ! include 'COMMON.CALC'
11852 ! include 'COMMON.CONTROL'
11854 !el local variables
11855 integer :: iint,itypi,itypi1,itypj,subchap
11856 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
11857 real(kind=8) :: sss,e1,e2,evdw,sss_grad
11858 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
11859 dist_temp, dist_init
11862 !cccc energy_dec=.false.
11863 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
11866 ! if (icall.eq.0) lprn=.false.
11868 do i=iatsc_s,iatsc_e
11870 if (itypi.eq.ntyp1) cycle
11875 xi=mod(xi,boxxsize)
11876 if (xi.lt.0) xi=xi+boxxsize
11877 yi=mod(yi,boxysize)
11878 if (yi.lt.0) yi=yi+boxysize
11879 zi=mod(zi,boxzsize)
11880 if (zi.lt.0) zi=zi+boxzsize
11881 dxi=dc_norm(1,nres+i)
11882 dyi=dc_norm(2,nres+i)
11883 dzi=dc_norm(3,nres+i)
11884 ! dsci_inv=dsc_inv(itypi)
11885 dsci_inv=vbld_inv(i+nres)
11886 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
11887 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
11889 ! Calculate SC interaction energy.
11891 do iint=1,nint_gr(i)
11892 do j=istart(i,iint),iend(i,iint)
11895 if (itypj.eq.ntyp1) cycle
11896 ! dscj_inv=dsc_inv(itypj)
11897 dscj_inv=vbld_inv(j+nres)
11898 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
11899 ! & 1.0d0/vbld(j+nres)
11900 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
11901 sig0ij=sigma(itypi,itypj)
11902 chi1=chi(itypi,itypj)
11903 chi2=chi(itypj,itypi)
11910 alf12=0.5D0*(alf1+alf2)
11914 ! Searching for nearest neighbour
11915 xj=mod(xj,boxxsize)
11916 if (xj.lt.0) xj=xj+boxxsize
11917 yj=mod(yj,boxysize)
11918 if (yj.lt.0) yj=yj+boxysize
11919 zj=mod(zj,boxzsize)
11920 if (zj.lt.0) zj=zj+boxzsize
11921 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
11929 xj=xj_safe+xshift*boxxsize
11930 yj=yj_safe+yshift*boxysize
11931 zj=zj_safe+zshift*boxzsize
11932 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
11933 if(dist_temp.lt.dist_init) then
11934 dist_init=dist_temp
11943 if (subchap.eq.1) then
11953 dxj=dc_norm(1,nres+j)
11954 dyj=dc_norm(2,nres+j)
11955 dzj=dc_norm(3,nres+j)
11956 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
11958 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
11959 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
11960 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
11961 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
11962 if (sss_ele_cut.le.0.0) cycle
11963 if (sss.lt.1.0d0) then
11965 ! Calculate angle-dependent terms of energy and contributions to their
11969 sig=sig0ij*dsqrt(sigsq)
11970 rij_shift=1.0D0/rij-sig+sig0ij
11971 ! for diagnostics; uncomment
11972 ! rij_shift=1.2*sig0ij
11973 ! I hate to put IF's in the loops, but here don't have another choice!!!!
11974 if (rij_shift.le.0.0D0) then
11976 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
11977 !d & restyp(itypi),i,restyp(itypj),j,
11978 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
11982 !---------------------------------------------------------------
11983 rij_shift=1.0D0/rij_shift
11984 fac=rij_shift**expon
11985 e1=fac*fac*aa(itypi,itypj)
11986 e2=fac*bb(itypi,itypj)
11987 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
11988 eps2der=evdwij*eps3rt
11989 eps3der=evdwij*eps2rt
11990 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
11991 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
11992 evdwij=evdwij*eps2rt*eps3rt
11993 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
11995 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
11996 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
11997 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
11998 restyp(itypi),i,restyp(itypj),j,&
11999 epsi,sigm,chi1,chi2,chip1,chip2,&
12000 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
12001 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
12005 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
12007 ! if (energy_dec) write (iout,*) &
12008 ! 'evdw',i,j,evdwij,"egb_long"
12010 ! Calculate gradient components.
12011 e1=e1*eps1*eps2rt**2*eps3rt**2
12012 fac=-expon*(e1+evdwij)*rij_shift
12015 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
12016 /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
12017 /sigmaii(itypi,itypj))
12019 ! Calculate the radial part of the gradient
12023 ! Calculate angular part of the gradient.
12024 call sc_grad_scale(1.0d0-sss)
12029 ! write (iout,*) "Number of loop steps in EGB:",ind
12030 !ccc energy_dec=.false.
12032 end subroutine egb_long
12033 !-----------------------------------------------------------------------------
12034 subroutine egb_short(evdw)
12036 ! This subroutine calculates the interaction energy of nonbonded side chains
12037 ! assuming the Gay-Berne potential of interaction.
12040 ! implicit real*8 (a-h,o-z)
12041 ! include 'DIMENSIONS'
12042 ! include 'COMMON.GEO'
12043 ! include 'COMMON.VAR'
12044 ! include 'COMMON.LOCAL'
12045 ! include 'COMMON.CHAIN'
12046 ! include 'COMMON.DERIV'
12047 ! include 'COMMON.NAMES'
12048 ! include 'COMMON.INTERACT'
12049 ! include 'COMMON.IOUNITS'
12050 ! include 'COMMON.CALC'
12051 ! include 'COMMON.CONTROL'
12053 !el local variables
12054 integer :: iint,itypi,itypi1,itypj,subchap
12055 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
12056 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
12057 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
12058 dist_temp, dist_init
12060 !cccc energy_dec=.false.
12061 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
12064 ! if (icall.eq.0) lprn=.false.
12066 do i=iatsc_s,iatsc_e
12068 if (itypi.eq.ntyp1) cycle
12073 xi=mod(xi,boxxsize)
12074 if (xi.lt.0) xi=xi+boxxsize
12075 yi=mod(yi,boxysize)
12076 if (yi.lt.0) yi=yi+boxysize
12077 zi=mod(zi,boxzsize)
12078 if (zi.lt.0) zi=zi+boxzsize
12079 dxi=dc_norm(1,nres+i)
12080 dyi=dc_norm(2,nres+i)
12081 dzi=dc_norm(3,nres+i)
12082 ! dsci_inv=dsc_inv(itypi)
12083 dsci_inv=vbld_inv(i+nres)
12085 dxi=dc_norm(1,nres+i)
12086 dyi=dc_norm(2,nres+i)
12087 dzi=dc_norm(3,nres+i)
12088 ! dsci_inv=dsc_inv(itypi)
12089 dsci_inv=vbld_inv(i+nres)
12090 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
12091 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
12093 ! Calculate SC interaction energy.
12095 do iint=1,nint_gr(i)
12096 do j=istart(i,iint),iend(i,iint)
12099 if (itypj.eq.ntyp1) cycle
12100 ! dscj_inv=dsc_inv(itypj)
12101 dscj_inv=vbld_inv(j+nres)
12102 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
12103 ! & 1.0d0/vbld(j+nres)
12104 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
12105 sig0ij=sigma(itypi,itypj)
12106 chi1=chi(itypi,itypj)
12107 chi2=chi(itypj,itypi)
12114 alf12=0.5D0*(alf1+alf2)
12115 ! xj=c(1,nres+j)-xi
12116 ! yj=c(2,nres+j)-yi
12117 ! zj=c(3,nres+j)-zi
12121 ! Searching for nearest neighbour
12122 xj=mod(xj,boxxsize)
12123 if (xj.lt.0) xj=xj+boxxsize
12124 yj=mod(yj,boxysize)
12125 if (yj.lt.0) yj=yj+boxysize
12126 zj=mod(zj,boxzsize)
12127 if (zj.lt.0) zj=zj+boxzsize
12128 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
12136 xj=xj_safe+xshift*boxxsize
12137 yj=yj_safe+yshift*boxysize
12138 zj=zj_safe+zshift*boxzsize
12139 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
12140 if(dist_temp.lt.dist_init) then
12141 dist_init=dist_temp
12150 if (subchap.eq.1) then
12160 dxj=dc_norm(1,nres+j)
12161 dyj=dc_norm(2,nres+j)
12162 dzj=dc_norm(3,nres+j)
12163 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12165 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12166 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
12167 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
12168 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
12169 if (sss_ele_cut.le.0.0) cycle
12171 if (sss.gt.0.0d0) then
12173 ! Calculate angle-dependent terms of energy and contributions to their
12177 sig=sig0ij*dsqrt(sigsq)
12178 rij_shift=1.0D0/rij-sig+sig0ij
12179 ! for diagnostics; uncomment
12180 ! rij_shift=1.2*sig0ij
12181 ! I hate to put IF's in the loops, but here don't have another choice!!!!
12182 if (rij_shift.le.0.0D0) then
12184 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
12185 !d & restyp(itypi),i,restyp(itypj),j,
12186 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
12190 !---------------------------------------------------------------
12191 rij_shift=1.0D0/rij_shift
12192 fac=rij_shift**expon
12193 e1=fac*fac*aa(itypi,itypj)
12194 e2=fac*bb(itypi,itypj)
12195 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12196 eps2der=evdwij*eps3rt
12197 eps3der=evdwij*eps2rt
12198 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
12199 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
12200 evdwij=evdwij*eps2rt*eps3rt
12201 evdw=evdw+evdwij*sss*sss_ele_cut
12203 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12204 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12205 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
12206 restyp(itypi),i,restyp(itypj),j,&
12207 epsi,sigm,chi1,chi2,chip1,chip2,&
12208 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
12209 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
12213 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
12215 ! if (energy_dec) write (iout,*) &
12216 ! 'evdw',i,j,evdwij,"egb_short"
12218 ! Calculate gradient components.
12219 e1=e1*eps1*eps2rt**2*eps3rt**2
12220 fac=-expon*(e1+evdwij)*rij_shift
12223 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
12224 /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
12225 /sigmaii(itypi,itypj))
12228 ! Calculate the radial part of the gradient
12232 ! Calculate angular part of the gradient.
12233 call sc_grad_scale(sss)
12238 ! write (iout,*) "Number of loop steps in EGB:",ind
12239 !ccc energy_dec=.false.
12241 end subroutine egb_short
12242 !-----------------------------------------------------------------------------
12243 subroutine egbv_long(evdw)
12245 ! This subroutine calculates the interaction energy of nonbonded side chains
12246 ! assuming the Gay-Berne-Vorobjev potential of interaction.
12249 ! implicit real*8 (a-h,o-z)
12250 ! include 'DIMENSIONS'
12251 ! include 'COMMON.GEO'
12252 ! include 'COMMON.VAR'
12253 ! include 'COMMON.LOCAL'
12254 ! include 'COMMON.CHAIN'
12255 ! include 'COMMON.DERIV'
12256 ! include 'COMMON.NAMES'
12257 ! include 'COMMON.INTERACT'
12258 ! include 'COMMON.IOUNITS'
12259 ! include 'COMMON.CALC'
12261 !el integer :: icall
12262 !el common /srutu/ icall
12264 !el local variables
12265 integer :: iint,itypi,itypi1,itypj
12266 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
12267 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
12269 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
12272 ! if (icall.eq.0) lprn=.true.
12274 do i=iatsc_s,iatsc_e
12276 if (itypi.eq.ntyp1) cycle
12281 dxi=dc_norm(1,nres+i)
12282 dyi=dc_norm(2,nres+i)
12283 dzi=dc_norm(3,nres+i)
12284 ! dsci_inv=dsc_inv(itypi)
12285 dsci_inv=vbld_inv(i+nres)
12287 ! Calculate SC interaction energy.
12289 do iint=1,nint_gr(i)
12290 do j=istart(i,iint),iend(i,iint)
12293 if (itypj.eq.ntyp1) cycle
12294 ! dscj_inv=dsc_inv(itypj)
12295 dscj_inv=vbld_inv(j+nres)
12296 sig0ij=sigma(itypi,itypj)
12297 r0ij=r0(itypi,itypj)
12298 chi1=chi(itypi,itypj)
12299 chi2=chi(itypj,itypi)
12306 alf12=0.5D0*(alf1+alf2)
12310 dxj=dc_norm(1,nres+j)
12311 dyj=dc_norm(2,nres+j)
12312 dzj=dc_norm(3,nres+j)
12313 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12316 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12318 if (sss.lt.1.0d0) then
12320 ! Calculate angle-dependent terms of energy and contributions to their
12324 sig=sig0ij*dsqrt(sigsq)
12325 rij_shift=1.0D0/rij-sig+r0ij
12326 ! I hate to put IF's in the loops, but here don't have another choice!!!!
12327 if (rij_shift.le.0.0D0) then
12332 !---------------------------------------------------------------
12333 rij_shift=1.0D0/rij_shift
12334 fac=rij_shift**expon
12335 e1=fac*fac*aa(itypi,itypj)
12336 e2=fac*bb(itypi,itypj)
12337 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12338 eps2der=evdwij*eps3rt
12339 eps3der=evdwij*eps2rt
12340 fac_augm=rrij**expon
12341 e_augm=augm(itypi,itypj)*fac_augm
12342 evdwij=evdwij*eps2rt*eps3rt
12343 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
12345 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12346 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12347 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
12348 restyp(itypi),i,restyp(itypj),j,&
12349 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
12350 chi1,chi2,chip1,chip2,&
12351 eps1,eps2rt**2,eps3rt**2,&
12352 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
12355 ! Calculate gradient components.
12356 e1=e1*eps1*eps2rt**2*eps3rt**2
12357 fac=-expon*(e1+evdwij)*rij_shift
12359 fac=rij*fac-2*expon*rrij*e_augm
12360 ! Calculate the radial part of the gradient
12364 ! Calculate angular part of the gradient.
12365 call sc_grad_scale(1.0d0-sss)
12370 end subroutine egbv_long
12371 !-----------------------------------------------------------------------------
12372 subroutine egbv_short(evdw)
12374 ! This subroutine calculates the interaction energy of nonbonded side chains
12375 ! assuming the Gay-Berne-Vorobjev potential of interaction.
12378 ! implicit real*8 (a-h,o-z)
12379 ! include 'DIMENSIONS'
12380 ! include 'COMMON.GEO'
12381 ! include 'COMMON.VAR'
12382 ! include 'COMMON.LOCAL'
12383 ! include 'COMMON.CHAIN'
12384 ! include 'COMMON.DERIV'
12385 ! include 'COMMON.NAMES'
12386 ! include 'COMMON.INTERACT'
12387 ! include 'COMMON.IOUNITS'
12388 ! include 'COMMON.CALC'
12390 !el integer :: icall
12391 !el common /srutu/ icall
12393 !el local variables
12394 integer :: iint,itypi,itypi1,itypj
12395 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
12396 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
12398 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
12401 ! if (icall.eq.0) lprn=.true.
12403 do i=iatsc_s,iatsc_e
12405 if (itypi.eq.ntyp1) cycle
12410 dxi=dc_norm(1,nres+i)
12411 dyi=dc_norm(2,nres+i)
12412 dzi=dc_norm(3,nres+i)
12413 ! dsci_inv=dsc_inv(itypi)
12414 dsci_inv=vbld_inv(i+nres)
12416 ! Calculate SC interaction energy.
12418 do iint=1,nint_gr(i)
12419 do j=istart(i,iint),iend(i,iint)
12422 if (itypj.eq.ntyp1) cycle
12423 ! dscj_inv=dsc_inv(itypj)
12424 dscj_inv=vbld_inv(j+nres)
12425 sig0ij=sigma(itypi,itypj)
12426 r0ij=r0(itypi,itypj)
12427 chi1=chi(itypi,itypj)
12428 chi2=chi(itypj,itypi)
12435 alf12=0.5D0*(alf1+alf2)
12439 dxj=dc_norm(1,nres+j)
12440 dyj=dc_norm(2,nres+j)
12441 dzj=dc_norm(3,nres+j)
12442 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12445 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12447 if (sss.gt.0.0d0) then
12449 ! Calculate angle-dependent terms of energy and contributions to their
12453 sig=sig0ij*dsqrt(sigsq)
12454 rij_shift=1.0D0/rij-sig+r0ij
12455 ! I hate to put IF's in the loops, but here don't have another choice!!!!
12456 if (rij_shift.le.0.0D0) then
12461 !---------------------------------------------------------------
12462 rij_shift=1.0D0/rij_shift
12463 fac=rij_shift**expon
12464 e1=fac*fac*aa(itypi,itypj)
12465 e2=fac*bb(itypi,itypj)
12466 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12467 eps2der=evdwij*eps3rt
12468 eps3der=evdwij*eps2rt
12469 fac_augm=rrij**expon
12470 e_augm=augm(itypi,itypj)*fac_augm
12471 evdwij=evdwij*eps2rt*eps3rt
12472 evdw=evdw+(evdwij+e_augm)*sss
12474 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12475 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12476 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
12477 restyp(itypi),i,restyp(itypj),j,&
12478 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
12479 chi1,chi2,chip1,chip2,&
12480 eps1,eps2rt**2,eps3rt**2,&
12481 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
12484 ! Calculate gradient components.
12485 e1=e1*eps1*eps2rt**2*eps3rt**2
12486 fac=-expon*(e1+evdwij)*rij_shift
12488 fac=rij*fac-2*expon*rrij*e_augm
12489 ! Calculate the radial part of the gradient
12493 ! Calculate angular part of the gradient.
12494 call sc_grad_scale(sss)
12499 end subroutine egbv_short
12500 !-----------------------------------------------------------------------------
12501 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
12503 ! This subroutine calculates the average interaction energy and its gradient
12504 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
12505 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
12506 ! The potential depends both on the distance of peptide-group centers and on
12507 ! the orientation of the CA-CA virtual bonds.
12509 ! implicit real*8 (a-h,o-z)
12515 ! include 'DIMENSIONS'
12516 ! include 'COMMON.CONTROL'
12517 ! include 'COMMON.SETUP'
12518 ! include 'COMMON.IOUNITS'
12519 ! include 'COMMON.GEO'
12520 ! include 'COMMON.VAR'
12521 ! include 'COMMON.LOCAL'
12522 ! include 'COMMON.CHAIN'
12523 ! include 'COMMON.DERIV'
12524 ! include 'COMMON.INTERACT'
12525 ! include 'COMMON.CONTACTS'
12526 ! include 'COMMON.TORSION'
12527 ! include 'COMMON.VECTORS'
12528 ! include 'COMMON.FFIELD'
12529 ! include 'COMMON.TIME1'
12530 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
12531 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
12532 real(kind=8),dimension(2,2) :: acipa !el,a_temp
12533 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
12534 real(kind=8),dimension(4) :: muij
12535 !el integer :: num_conti,j1,j2
12536 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
12537 !el dz_normi,xmedi,ymedi,zmedi
12538 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
12539 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
12540 !el num_conti,j1,j2
12541 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
12543 real(kind=8) :: scal_el=1.0d0
12545 real(kind=8) :: scal_el=0.5d0
12548 ! 13-go grudnia roku pamietnego...
12549 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
12550 0.0d0,1.0d0,0.0d0,&
12551 0.0d0,0.0d0,1.0d0/),shape(unmat))
12552 !el local variables
12554 real(kind=8) :: fac
12555 real(kind=8) :: dxj,dyj,dzj
12556 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
12558 ! allocate(num_cont_hb(nres)) !(maxres)
12559 !d write(iout,*) 'In EELEC'
12561 !d write(iout,*) 'Type',i
12562 !d write(iout,*) 'B1',B1(:,i)
12563 !d write(iout,*) 'B2',B2(:,i)
12564 !d write(iout,*) 'CC',CC(:,:,i)
12565 !d write(iout,*) 'DD',DD(:,:,i)
12566 !d write(iout,*) 'EE',EE(:,:,i)
12568 !d call check_vecgrad
12570 if (icheckgrad.eq.1) then
12572 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
12574 dc_norm(k,i)=dc(k,i)*fac
12576 ! write (iout,*) 'i',i,' fac',fac
12579 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
12580 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
12581 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
12582 ! call vec_and_deriv
12588 time_mat=time_mat+MPI_Wtime()-time01
12592 !d write (iout,*) 'i=',i
12594 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
12597 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
12598 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
12611 !d print '(a)','Enter EELEC'
12612 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
12613 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
12614 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
12616 gel_loc_loc(i)=0.0d0
12621 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
12623 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
12625 do i=iturn3_start,iturn3_end
12626 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1 &
12627 .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
12631 dx_normi=dc_norm(1,i)
12632 dy_normi=dc_norm(2,i)
12633 dz_normi=dc_norm(3,i)
12634 xmedi=c(1,i)+0.5d0*dxi
12635 ymedi=c(2,i)+0.5d0*dyi
12636 zmedi=c(3,i)+0.5d0*dzi
12638 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
12639 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
12640 num_cont_hb(i)=num_conti
12642 do i=iturn4_start,iturn4_end
12643 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
12644 .or. itype(i+3).eq.ntyp1 &
12645 .or. itype(i+4).eq.ntyp1) cycle
12649 dx_normi=dc_norm(1,i)
12650 dy_normi=dc_norm(2,i)
12651 dz_normi=dc_norm(3,i)
12652 xmedi=c(1,i)+0.5d0*dxi
12653 ymedi=c(2,i)+0.5d0*dyi
12654 zmedi=c(3,i)+0.5d0*dzi
12655 num_conti=num_cont_hb(i)
12656 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
12657 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
12658 call eturn4(i,eello_turn4)
12659 num_cont_hb(i)=num_conti
12662 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
12664 do i=iatel_s,iatel_e
12665 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
12669 dx_normi=dc_norm(1,i)
12670 dy_normi=dc_norm(2,i)
12671 dz_normi=dc_norm(3,i)
12672 xmedi=c(1,i)+0.5d0*dxi
12673 ymedi=c(2,i)+0.5d0*dyi
12674 zmedi=c(3,i)+0.5d0*dzi
12675 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
12676 num_conti=num_cont_hb(i)
12677 do j=ielstart(i),ielend(i)
12678 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
12679 call eelecij_scale(i,j,ees,evdw1,eel_loc)
12681 num_cont_hb(i)=num_conti
12683 ! write (iout,*) "Number of loop steps in EELEC:",ind
12685 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
12686 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
12688 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
12689 !cc eel_loc=eel_loc+eello_turn3
12690 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
12692 end subroutine eelec_scale
12693 !-----------------------------------------------------------------------------
12694 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
12695 ! implicit real*8 (a-h,o-z)
12698 ! include 'DIMENSIONS'
12702 ! include 'COMMON.CONTROL'
12703 ! include 'COMMON.IOUNITS'
12704 ! include 'COMMON.GEO'
12705 ! include 'COMMON.VAR'
12706 ! include 'COMMON.LOCAL'
12707 ! include 'COMMON.CHAIN'
12708 ! include 'COMMON.DERIV'
12709 ! include 'COMMON.INTERACT'
12710 ! include 'COMMON.CONTACTS'
12711 ! include 'COMMON.TORSION'
12712 ! include 'COMMON.VECTORS'
12713 ! include 'COMMON.FFIELD'
12714 ! include 'COMMON.TIME1'
12715 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
12716 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
12717 real(kind=8),dimension(2,2) :: acipa !el,a_temp
12718 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
12719 real(kind=8),dimension(4) :: muij
12720 !el integer :: num_conti,j1,j2
12721 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
12722 !el dz_normi,xmedi,ymedi,zmedi
12723 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
12724 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
12725 !el num_conti,j1,j2
12726 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
12728 real(kind=8) :: scal_el=1.0d0
12730 real(kind=8) :: scal_el=0.5d0
12733 ! 13-go grudnia roku pamietnego...
12734 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
12735 0.0d0,1.0d0,0.0d0,&
12736 0.0d0,0.0d0,1.0d0/),shape(unmat))
12737 !el local variables
12738 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m
12739 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
12740 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
12741 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
12742 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
12743 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
12744 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
12745 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
12746 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
12747 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
12748 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
12749 ecosam,ecosbm,ecosgm,ghalf,time00
12750 ! integer :: maxconts
12751 ! maxconts = nres/4
12752 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12753 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12754 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12755 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12756 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12757 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12758 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12759 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
12760 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
12761 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
12762 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
12763 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
12764 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
12766 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
12767 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
12772 !d write (iout,*) "eelecij",i,j
12776 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
12777 aaa=app(iteli,itelj)
12778 bbb=bpp(iteli,itelj)
12779 ael6i=ael6(iteli,itelj)
12780 ael3i=ael3(iteli,itelj)
12784 dx_normj=dc_norm(1,j)
12785 dy_normj=dc_norm(2,j)
12786 dz_normj=dc_norm(3,j)
12787 xj=c(1,j)+0.5D0*dxj-xmedi
12788 yj=c(2,j)+0.5D0*dyj-ymedi
12789 zj=c(3,j)+0.5D0*dzj-zmedi
12790 rij=xj*xj+yj*yj+zj*zj
12794 ! For extracting the short-range part of Evdwpp
12795 sss=sscale(rij/rpp(iteli,itelj))
12799 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
12800 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
12801 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
12802 fac=cosa-3.0D0*cosb*cosg
12804 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
12805 if (j.eq.i+2) ev1=scal_el*ev1
12810 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
12813 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
12814 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
12816 evdw1=evdw1+evdwij*(1.0d0-sss)
12817 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
12818 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
12819 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
12820 !d & xmedi,ymedi,zmedi,xj,yj,zj
12822 if (energy_dec) then
12823 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
12824 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
12828 ! Calculate contributions to the Cartesian gradient.
12831 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)
12832 facel=-3*rrmij*(el1+eesij)
12838 ! Radial derivatives. First process both termini of the fragment (i,j)
12844 ! ghalf=0.5D0*ggg(k)
12845 ! gelc(k,i)=gelc(k,i)+ghalf
12846 ! gelc(k,j)=gelc(k,j)+ghalf
12848 ! 9/28/08 AL Gradient compotents will be summed only at the end
12850 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
12851 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
12854 ! Loop over residues i+1 thru j-1.
12858 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12865 ! ghalf=0.5D0*ggg(k)
12866 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
12867 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
12869 ! 9/28/08 AL Gradient compotents will be summed only at the end
12871 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12872 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12875 ! Loop over residues i+1 thru j-1.
12879 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
12883 facvdw=ev1+evdwij*(1.0d0-sss)
12886 fac=-3*rrmij*(facvdw+facvdw+facel)
12891 ! Radial derivatives. First process both termini of the fragment (i,j)
12897 ! ghalf=0.5D0*ggg(k)
12898 ! gelc(k,i)=gelc(k,i)+ghalf
12899 ! gelc(k,j)=gelc(k,j)+ghalf
12901 ! 9/28/08 AL Gradient compotents will be summed only at the end
12903 gelc_long(k,j)=gelc(k,j)+ggg(k)
12904 gelc_long(k,i)=gelc(k,i)-ggg(k)
12907 ! Loop over residues i+1 thru j-1.
12911 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12914 ! 9/28/08 AL Gradient compotents will be summed only at the end
12919 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
12920 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
12926 ecosa=2.0D0*fac3*fac1+fac4
12929 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
12930 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
12932 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
12933 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
12935 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
12936 !d & (dcosg(k),k=1,3)
12938 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
12941 ! ghalf=0.5D0*ggg(k)
12942 ! gelc(k,i)=gelc(k,i)+ghalf
12943 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
12944 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12945 ! gelc(k,j)=gelc(k,j)+ghalf
12946 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
12947 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12951 !grad gelc(l,k)=gelc(l,k)+ggg(l)
12955 gelc(k,i)=gelc(k,i) &
12956 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
12957 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
12958 gelc(k,j)=gelc(k,j) &
12959 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
12960 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
12961 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
12962 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
12964 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
12965 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
12966 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
12968 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
12969 ! energy of a peptide unit is assumed in the form of a second-order
12970 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
12971 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
12972 ! are computed for EVERY pair of non-contiguous peptide groups.
12974 if (j.lt.nres-1) then
12985 muij(kkk)=mu(k,i)*mu(l,j)
12988 !d write (iout,*) 'EELEC: i',i,' j',j
12989 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
12990 !d write(iout,*) 'muij',muij
12991 ury=scalar(uy(1,i),erij)
12992 urz=scalar(uz(1,i),erij)
12993 vry=scalar(uy(1,j),erij)
12994 vrz=scalar(uz(1,j),erij)
12995 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
12996 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
12997 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
12998 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
12999 fac=dsqrt(-ael6i)*r3ij
13004 !d write (iout,'(4i5,4f10.5)')
13005 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
13006 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
13007 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
13008 !d & uy(:,j),uz(:,j)
13009 !d write (iout,'(4f10.5)')
13010 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
13011 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
13012 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
13013 !d write (iout,'(9f10.5/)')
13014 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
13015 ! Derivatives of the elements of A in virtual-bond vectors
13016 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
13018 uryg(k,1)=scalar(erder(1,k),uy(1,i))
13019 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
13020 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
13021 urzg(k,1)=scalar(erder(1,k),uz(1,i))
13022 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
13023 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
13024 vryg(k,1)=scalar(erder(1,k),uy(1,j))
13025 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
13026 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
13027 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
13028 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
13029 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
13031 ! Compute radial contributions to the gradient
13049 ! Add the contributions coming from er
13052 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
13053 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
13054 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
13055 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
13058 ! Derivatives in DC(i)
13059 !grad ghalf1=0.5d0*agg(k,1)
13060 !grad ghalf2=0.5d0*agg(k,2)
13061 !grad ghalf3=0.5d0*agg(k,3)
13062 !grad ghalf4=0.5d0*agg(k,4)
13063 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
13064 -3.0d0*uryg(k,2)*vry)!+ghalf1
13065 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
13066 -3.0d0*uryg(k,2)*vrz)!+ghalf2
13067 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
13068 -3.0d0*urzg(k,2)*vry)!+ghalf3
13069 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
13070 -3.0d0*urzg(k,2)*vrz)!+ghalf4
13071 ! Derivatives in DC(i+1)
13072 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
13073 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
13074 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
13075 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
13076 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
13077 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
13078 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
13079 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
13080 ! Derivatives in DC(j)
13081 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
13082 -3.0d0*vryg(k,2)*ury)!+ghalf1
13083 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
13084 -3.0d0*vrzg(k,2)*ury)!+ghalf2
13085 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
13086 -3.0d0*vryg(k,2)*urz)!+ghalf3
13087 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
13088 -3.0d0*vrzg(k,2)*urz)!+ghalf4
13089 ! Derivatives in DC(j+1) or DC(nres-1)
13090 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
13091 -3.0d0*vryg(k,3)*ury)
13092 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
13093 -3.0d0*vrzg(k,3)*ury)
13094 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
13095 -3.0d0*vryg(k,3)*urz)
13096 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
13097 -3.0d0*vrzg(k,3)*urz)
13098 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
13100 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
13113 aggi(k,l)=-aggi(k,l)
13114 aggi1(k,l)=-aggi1(k,l)
13115 aggj(k,l)=-aggj(k,l)
13116 aggj1(k,l)=-aggj1(k,l)
13119 if (j.lt.nres-1) then
13125 aggi(k,l)=-aggi(k,l)
13126 aggi1(k,l)=-aggi1(k,l)
13127 aggj(k,l)=-aggj(k,l)
13128 aggj1(k,l)=-aggj1(k,l)
13139 aggi(k,l)=-aggi(k,l)
13140 aggi1(k,l)=-aggi1(k,l)
13141 aggj(k,l)=-aggj(k,l)
13142 aggj1(k,l)=-aggj1(k,l)
13147 IF (wel_loc.gt.0.0d0) THEN
13148 ! Contribution to the local-electrostatic energy coming from the i-j pair
13149 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
13151 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
13153 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13154 'eelloc',i,j,eel_loc_ij
13155 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
13157 eel_loc=eel_loc+eel_loc_ij
13158 ! Partial derivatives in virtual-bond dihedral angles gamma
13160 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
13161 a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
13162 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
13163 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
13164 a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
13165 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
13166 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
13168 ggg(l)=agg(l,1)*muij(1)+ &
13169 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
13170 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
13171 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
13172 !grad ghalf=0.5d0*ggg(l)
13173 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
13174 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
13178 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
13181 ! Remaining derivatives of eello
13183 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ &
13184 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
13185 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ &
13186 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
13187 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ &
13188 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
13189 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ &
13190 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
13193 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
13194 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
13195 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
13196 .and. num_conti.le.maxconts) then
13197 ! write (iout,*) i,j," entered corr"
13199 ! Calculate the contact function. The ith column of the array JCONT will
13200 ! contain the numbers of atoms that make contacts with the atom I (of numbers
13201 ! greater than I). The arrays FACONT and GACONT will contain the values of
13202 ! the contact function and its derivative.
13203 ! r0ij=1.02D0*rpp(iteli,itelj)
13204 ! r0ij=1.11D0*rpp(iteli,itelj)
13205 r0ij=2.20D0*rpp(iteli,itelj)
13206 ! r0ij=1.55D0*rpp(iteli,itelj)
13207 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
13208 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
13209 if (fcont.gt.0.0D0) then
13210 num_conti=num_conti+1
13211 if (num_conti.gt.maxconts) then
13212 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
13213 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
13214 ' will skip next contacts for this conf.',num_conti
13216 jcont_hb(num_conti,i)=j
13217 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
13218 !d & " jcont_hb",jcont_hb(num_conti,i)
13219 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
13220 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
13221 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
13223 d_cont(num_conti,i)=rij
13224 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
13225 ! --- Electrostatic-interaction matrix ---
13226 a_chuj(1,1,num_conti,i)=a22
13227 a_chuj(1,2,num_conti,i)=a23
13228 a_chuj(2,1,num_conti,i)=a32
13229 a_chuj(2,2,num_conti,i)=a33
13230 ! --- Gradient of rij
13232 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
13239 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
13240 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
13241 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
13242 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
13243 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
13248 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
13249 ! Calculate contact energies
13251 wij=cosa-3.0D0*cosb*cosg
13254 ! fac3=dsqrt(-ael6i)/r0ij**3
13255 fac3=dsqrt(-ael6i)*r3ij
13256 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
13257 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
13258 if (ees0tmp.gt.0) then
13259 ees0pij=dsqrt(ees0tmp)
13263 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
13264 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
13265 if (ees0tmp.gt.0) then
13266 ees0mij=dsqrt(ees0tmp)
13271 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
13272 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
13273 ! Diagnostics. Comment out or remove after debugging!
13274 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
13275 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
13276 ! ees0m(num_conti,i)=0.0D0
13278 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
13279 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
13280 ! Angular derivatives of the contact function
13281 ees0pij1=fac3/ees0pij
13282 ees0mij1=fac3/ees0mij
13283 fac3p=-3.0D0*fac3*rrmij
13284 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
13285 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
13287 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
13288 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
13289 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
13290 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
13291 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
13292 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
13293 ecosap=ecosa1+ecosa2
13294 ecosbp=ecosb1+ecosb2
13295 ecosgp=ecosg1+ecosg2
13296 ecosam=ecosa1-ecosa2
13297 ecosbm=ecosb1-ecosb2
13298 ecosgm=ecosg1-ecosg2
13307 facont_hb(num_conti,i)=fcont
13308 fprimcont=fprimcont/rij
13309 !d facont_hb(num_conti,i)=1.0D0
13310 ! Following line is for diagnostics.
13313 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
13314 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
13317 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
13318 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
13320 gggp(1)=gggp(1)+ees0pijp*xj
13321 gggp(2)=gggp(2)+ees0pijp*yj
13322 gggp(3)=gggp(3)+ees0pijp*zj
13323 gggm(1)=gggm(1)+ees0mijp*xj
13324 gggm(2)=gggm(2)+ees0mijp*yj
13325 gggm(3)=gggm(3)+ees0mijp*zj
13326 ! Derivatives due to the contact function
13327 gacont_hbr(1,num_conti,i)=fprimcont*xj
13328 gacont_hbr(2,num_conti,i)=fprimcont*yj
13329 gacont_hbr(3,num_conti,i)=fprimcont*zj
13332 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
13333 ! following the change of gradient-summation algorithm.
13335 !grad ghalfp=0.5D0*gggp(k)
13336 !grad ghalfm=0.5D0*gggm(k)
13337 gacontp_hb1(k,num_conti,i)= & !ghalfp
13338 +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
13339 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
13340 gacontp_hb2(k,num_conti,i)= & !ghalfp
13341 +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
13342 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
13343 gacontp_hb3(k,num_conti,i)=gggp(k)
13344 gacontm_hb1(k,num_conti,i)= &!ghalfm
13345 +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
13346 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
13347 gacontm_hb2(k,num_conti,i)= & !ghalfm
13348 +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
13349 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
13350 gacontm_hb3(k,num_conti,i)=gggm(k)
13353 endif ! num_conti.le.maxconts
13356 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
13359 ghalf=0.5d0*agg(l,k)
13360 aggi(l,k)=aggi(l,k)+ghalf
13361 aggi1(l,k)=aggi1(l,k)+agg(l,k)
13362 aggj(l,k)=aggj(l,k)+ghalf
13365 if (j.eq.nres-1 .and. i.lt.j-2) then
13368 aggj1(l,k)=aggj1(l,k)+agg(l,k)
13373 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
13375 end subroutine eelecij_scale
13376 !-----------------------------------------------------------------------------
13377 subroutine evdwpp_short(evdw1)
13381 ! implicit real*8 (a-h,o-z)
13382 ! include 'DIMENSIONS'
13383 ! include 'COMMON.CONTROL'
13384 ! include 'COMMON.IOUNITS'
13385 ! include 'COMMON.GEO'
13386 ! include 'COMMON.VAR'
13387 ! include 'COMMON.LOCAL'
13388 ! include 'COMMON.CHAIN'
13389 ! include 'COMMON.DERIV'
13390 ! include 'COMMON.INTERACT'
13391 ! include 'COMMON.CONTACTS'
13392 ! include 'COMMON.TORSION'
13393 ! include 'COMMON.VECTORS'
13394 ! include 'COMMON.FFIELD'
13395 real(kind=8),dimension(3) :: ggg
13396 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13398 real(kind=8) :: scal_el=1.0d0
13400 real(kind=8) :: scal_el=0.5d0
13402 !el local variables
13403 integer :: i,j,k,iteli,itelj,num_conti
13404 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
13405 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
13406 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13407 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
13410 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
13411 ! & " iatel_e_vdw",iatel_e_vdw
13413 do i=iatel_s_vdw,iatel_e_vdw
13414 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle
13418 dx_normi=dc_norm(1,i)
13419 dy_normi=dc_norm(2,i)
13420 dz_normi=dc_norm(3,i)
13421 xmedi=c(1,i)+0.5d0*dxi
13422 ymedi=c(2,i)+0.5d0*dyi
13423 zmedi=c(3,i)+0.5d0*dzi
13425 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
13426 ! & ' ielend',ielend_vdw(i)
13428 do j=ielstart_vdw(i),ielend_vdw(i)
13429 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
13433 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
13434 aaa=app(iteli,itelj)
13435 bbb=bpp(iteli,itelj)
13439 dx_normj=dc_norm(1,j)
13440 dy_normj=dc_norm(2,j)
13441 dz_normj=dc_norm(3,j)
13442 xj=c(1,j)+0.5D0*dxj-xmedi
13443 yj=c(2,j)+0.5D0*dyj-ymedi
13444 zj=c(3,j)+0.5D0*dzj-zmedi
13445 rij=xj*xj+yj*yj+zj*zj
13448 sss=sscale(rij/rpp(iteli,itelj))
13449 if (sss.gt.0.0d0) then
13454 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
13455 if (j.eq.i+2) ev1=scal_el*ev1
13458 if (energy_dec) then
13459 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
13461 evdw1=evdw1+evdwij*sss
13463 ! Calculate contributions to the Cartesian gradient.
13465 facvdw=-6*rrmij*(ev1+evdwij)*sss
13470 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
13471 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
13477 end subroutine evdwpp_short
13478 !-----------------------------------------------------------------------------
13479 subroutine escp_long(evdw2,evdw2_14)
13481 ! This subroutine calculates the excluded-volume interaction energy between
13482 ! peptide-group centers and side chains and its gradient in virtual-bond and
13483 ! side-chain vectors.
13485 ! implicit real*8 (a-h,o-z)
13486 ! include 'DIMENSIONS'
13487 ! include 'COMMON.GEO'
13488 ! include 'COMMON.VAR'
13489 ! include 'COMMON.LOCAL'
13490 ! include 'COMMON.CHAIN'
13491 ! include 'COMMON.DERIV'
13492 ! include 'COMMON.INTERACT'
13493 ! include 'COMMON.FFIELD'
13494 ! include 'COMMON.IOUNITS'
13495 ! include 'COMMON.CONTROL'
13496 real(kind=8),dimension(3) :: ggg
13497 !el local variables
13498 integer :: i,iint,j,k,iteli,itypj
13499 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2
13500 real(kind=8) :: evdw2,evdw2_14,evdwij
13503 !d print '(a)','Enter ESCP'
13504 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
13505 do i=iatscp_s,iatscp_e
13506 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
13508 xi=0.5D0*(c(1,i)+c(1,i+1))
13509 yi=0.5D0*(c(2,i)+c(2,i+1))
13510 zi=0.5D0*(c(3,i)+c(3,i+1))
13512 do iint=1,nscp_gr(i)
13514 do j=iscpstart(i,iint),iscpend(i,iint)
13516 if (itypj.eq.ntyp1) cycle
13517 ! Uncomment following three lines for SC-p interactions
13518 ! xj=c(1,nres+j)-xi
13519 ! yj=c(2,nres+j)-yi
13520 ! zj=c(3,nres+j)-zi
13521 ! Uncomment following three lines for Ca-p interactions
13525 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13527 sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
13529 if (sss.lt.1.0d0) then
13532 e1=fac*fac*aad(itypj,iteli)
13533 e2=fac*bad(itypj,iteli)
13534 if (iabs(j-i) .le. 2) then
13537 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)
13540 evdw2=evdw2+evdwij*(1.0d0-sss)
13541 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
13542 'evdw2',i,j,sss,evdwij
13544 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
13546 fac=-(evdwij+e1)*rrij*(1.0d0-sss)
13550 ! Uncomment following three lines for SC-p interactions
13552 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
13554 ! Uncomment following line for SC-p interactions
13555 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
13557 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
13558 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
13567 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
13568 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
13569 gradx_scp(j,i)=expon*gradx_scp(j,i)
13572 !******************************************************************************
13576 ! To save time the factor EXPON has been extracted from ALL components
13577 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
13580 !******************************************************************************
13582 end subroutine escp_long
13583 !-----------------------------------------------------------------------------
13584 subroutine escp_short(evdw2,evdw2_14)
13586 ! This subroutine calculates the excluded-volume interaction energy between
13587 ! peptide-group centers and side chains and its gradient in virtual-bond and
13588 ! side-chain vectors.
13590 ! implicit real*8 (a-h,o-z)
13591 ! include 'DIMENSIONS'
13592 ! include 'COMMON.GEO'
13593 ! include 'COMMON.VAR'
13594 ! include 'COMMON.LOCAL'
13595 ! include 'COMMON.CHAIN'
13596 ! include 'COMMON.DERIV'
13597 ! include 'COMMON.INTERACT'
13598 ! include 'COMMON.FFIELD'
13599 ! include 'COMMON.IOUNITS'
13600 ! include 'COMMON.CONTROL'
13601 real(kind=8),dimension(3) :: ggg
13602 !el local variables
13603 integer :: i,iint,j,k,iteli,itypj
13604 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2
13605 real(kind=8) :: evdw2,evdw2_14,evdwij
13608 !d print '(a)','Enter ESCP'
13609 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
13610 do i=iatscp_s,iatscp_e
13611 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
13613 xi=0.5D0*(c(1,i)+c(1,i+1))
13614 yi=0.5D0*(c(2,i)+c(2,i+1))
13615 zi=0.5D0*(c(3,i)+c(3,i+1))
13617 do iint=1,nscp_gr(i)
13619 do j=iscpstart(i,iint),iscpend(i,iint)
13621 if (itypj.eq.ntyp1) cycle
13622 ! Uncomment following three lines for SC-p interactions
13623 ! xj=c(1,nres+j)-xi
13624 ! yj=c(2,nres+j)-yi
13625 ! zj=c(3,nres+j)-zi
13626 ! Uncomment following three lines for Ca-p interactions
13630 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13632 sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
13634 if (sss.gt.0.0d0) then
13637 e1=fac*fac*aad(itypj,iteli)
13638 e2=fac*bad(itypj,iteli)
13639 if (iabs(j-i) .le. 2) then
13642 evdw2_14=evdw2_14+(e1+e2)*sss
13645 evdw2=evdw2+evdwij*sss
13646 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
13647 'evdw2',i,j,sss,evdwij
13649 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
13651 fac=-(evdwij+e1)*rrij*sss
13655 ! Uncomment following three lines for SC-p interactions
13657 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
13659 ! Uncomment following line for SC-p interactions
13660 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
13662 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
13663 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
13672 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
13673 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
13674 gradx_scp(j,i)=expon*gradx_scp(j,i)
13677 !******************************************************************************
13681 ! To save time the factor EXPON has been extracted from ALL components
13682 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
13685 !******************************************************************************
13687 end subroutine escp_short
13688 !-----------------------------------------------------------------------------
13689 ! energy_p_new-sep_barrier.F
13690 !-----------------------------------------------------------------------------
13691 subroutine sc_grad_scale(scalfac)
13692 ! implicit real*8 (a-h,o-z)
13694 ! include 'DIMENSIONS'
13695 ! include 'COMMON.CHAIN'
13696 ! include 'COMMON.DERIV'
13697 ! include 'COMMON.CALC'
13698 ! include 'COMMON.IOUNITS'
13699 real(kind=8),dimension(3) :: dcosom1,dcosom2
13700 real(kind=8) :: scalfac
13701 !el local variables
13702 ! integer :: i,j,k,l
13704 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
13705 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
13706 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
13707 -2.0D0*alf12*eps3der+sigder*sigsq_om12
13711 ! eom12=evdwij*eps1_om12
13713 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
13714 ! & " sigder",sigder
13715 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
13716 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
13718 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
13719 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
13722 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
13725 ! write (iout,*) "gg",(gg(k),k=1,3)
13727 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
13728 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
13729 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
13731 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
13732 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
13733 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
13735 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
13736 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
13737 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
13738 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
13741 ! Calculate the components of the gradient in DC and X
13744 gvdwc(l,i)=gvdwc(l,i)-gg(l)
13745 gvdwc(l,j)=gvdwc(l,j)+gg(l)
13748 end subroutine sc_grad_scale
13749 !-----------------------------------------------------------------------------
13750 ! energy_split-sep.F
13751 !-----------------------------------------------------------------------------
13752 subroutine etotal_long(energia)
13754 ! Compute the long-range slow-varying contributions to the energy
13756 ! implicit real*8 (a-h,o-z)
13757 ! include 'DIMENSIONS'
13758 use MD_data, only: totT,usampl,eq_time
13762 !MS$ATTRIBUTES C :: proc_proc
13767 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
13769 ! include 'COMMON.SETUP'
13770 ! include 'COMMON.IOUNITS'
13771 ! include 'COMMON.FFIELD'
13772 ! include 'COMMON.DERIV'
13773 ! include 'COMMON.INTERACT'
13774 ! include 'COMMON.SBRIDGE'
13775 ! include 'COMMON.CHAIN'
13776 ! include 'COMMON.VAR'
13777 ! include 'COMMON.LOCAL'
13778 ! include 'COMMON.MD'
13779 real(kind=8),dimension(0:n_ene) :: energia
13780 !el local variables
13781 integer :: i,n_corr,n_corr1,ierror,ierr
13782 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
13783 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
13784 ecorr,ecorr5,ecorr6,eturn6,time00
13785 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
13786 !elwrite(iout,*)"in etotal long"
13788 if (modecalc.eq.12.or.modecalc.eq.14) then
13790 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
13792 call int_from_cart1(.false.)
13795 !elwrite(iout,*)"in etotal long"
13798 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
13799 ! & " absolute rank",myrank," nfgtasks",nfgtasks
13801 if (nfgtasks.gt.1) then
13803 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
13804 if (fg_rank.eq.0) then
13805 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
13806 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
13808 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
13809 ! FG slaves as WEIGHTS array.
13816 weights_(7)=wel_loc
13819 weights_(10)=wturn6
13821 weights_(12)=wscloc
13823 weights_(14)=wtor_d
13824 weights_(15)=wstrain
13825 weights_(16)=wvdwpp
13827 weights_(18)=scal14
13828 weights_(21)=wsccor
13829 ! FG Master broadcasts the WEIGHTS_ array
13830 call MPI_Bcast(weights_(1),n_ene,&
13831 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13833 ! FG slaves receive the WEIGHTS array
13834 call MPI_Bcast(weights(1),n_ene,&
13835 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
13850 wstrain=weights(15)
13856 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
13858 time_Bcast=time_Bcast+MPI_Wtime()-time00
13859 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
13860 ! call chainbuild_cart
13861 ! call int_from_cart1(.false.)
13863 ! write (iout,*) 'Processor',myrank,
13864 ! & ' calling etotal_short ipot=',ipot
13866 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
13868 !d print *,'nnt=',nnt,' nct=',nct
13870 !elwrite(iout,*)"in etotal long"
13871 ! Compute the side-chain and electrostatic interaction energy
13873 goto (101,102,103,104,105,106) ipot
13874 ! Lennard-Jones potential.
13875 101 call elj_long(evdw)
13876 !d print '(a)','Exit ELJ'
13878 ! Lennard-Jones-Kihara potential (shifted).
13879 102 call eljk_long(evdw)
13881 ! Berne-Pechukas potential (dilated LJ, angular dependence).
13882 103 call ebp_long(evdw)
13884 ! Gay-Berne potential (shifted LJ, angular dependence).
13885 104 call egb_long(evdw)
13887 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
13888 105 call egbv_long(evdw)
13890 ! Soft-sphere potential
13891 106 call e_softsphere(evdw)
13893 ! Calculate electrostatic (H-bonding) energy of the main chain.
13897 if (ipot.lt.6) then
13899 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
13900 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
13901 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
13902 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
13904 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
13905 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
13906 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
13907 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
13909 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13918 ! write (iout,*) "Soft-spheer ELEC potential"
13919 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
13923 ! Calculate excluded-volume interaction energy between peptide groups
13926 if (ipot.lt.6) then
13927 if(wscp.gt.0d0) then
13928 call escp_long(evdw2,evdw2_14)
13934 call escp_soft_sphere(evdw2,evdw2_14)
13937 ! 12/1/95 Multi-body terms
13941 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
13942 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
13943 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
13944 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
13945 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
13952 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
13953 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
13956 ! If performing constraint dynamics, call the constraint energy
13957 ! after the equilibration time
13958 if(usampl.and.totT.gt.eq_time) then
13973 energia(2)=evdw2-evdw2_14
13974 energia(18)=evdw2_14
13983 energia(3)=ees+evdw1
13990 energia(8)=eello_turn3
13991 energia(9)=eello_turn4
13993 energia(20)=Uconst+Uconst_back
13994 call sum_energy(energia,.true.)
13995 ! write (iout,*) "Exit ETOTAL_LONG"
13998 end subroutine etotal_long
13999 !-----------------------------------------------------------------------------
14000 subroutine etotal_short(energia)
14002 ! Compute the short-range fast-varying contributions to the energy
14004 ! implicit real*8 (a-h,o-z)
14005 ! include 'DIMENSIONS'
14009 !MS$ATTRIBUTES C :: proc_proc
14014 integer :: ierror,ierr
14015 real(kind=8),dimension(n_ene) :: weights_
14016 real(kind=8) :: time00
14018 ! include 'COMMON.SETUP'
14019 ! include 'COMMON.IOUNITS'
14020 ! include 'COMMON.FFIELD'
14021 ! include 'COMMON.DERIV'
14022 ! include 'COMMON.INTERACT'
14023 ! include 'COMMON.SBRIDGE'
14024 ! include 'COMMON.CHAIN'
14025 ! include 'COMMON.VAR'
14026 ! include 'COMMON.LOCAL'
14027 real(kind=8),dimension(0:n_ene) :: energia
14028 !el local variables
14030 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
14031 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr
14034 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
14036 if (modecalc.eq.12.or.modecalc.eq.14) then
14038 if (fg_rank.eq.0) call int_from_cart1(.false.)
14040 call int_from_cart1(.false.)
14044 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
14045 ! & " absolute rank",myrank," nfgtasks",nfgtasks
14047 if (nfgtasks.gt.1) then
14049 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
14050 if (fg_rank.eq.0) then
14051 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
14052 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
14054 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
14055 ! FG slaves as WEIGHTS array.
14062 weights_(7)=wel_loc
14065 weights_(10)=wturn6
14067 weights_(12)=wscloc
14069 weights_(14)=wtor_d
14070 weights_(15)=wstrain
14071 weights_(16)=wvdwpp
14073 weights_(18)=scal14
14074 weights_(21)=wsccor
14075 ! FG Master broadcasts the WEIGHTS_ array
14076 call MPI_Bcast(weights_(1),n_ene,&
14077 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
14079 ! FG slaves receive the WEIGHTS array
14080 call MPI_Bcast(weights(1),n_ene,&
14081 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
14096 wstrain=weights(15)
14102 ! write (iout,*),"Processor",myrank," BROADCAST weights"
14103 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
14105 ! write (iout,*) "Processor",myrank," BROADCAST c"
14106 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
14108 ! write (iout,*) "Processor",myrank," BROADCAST dc"
14109 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
14111 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
14112 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
14114 ! write (iout,*) "Processor",myrank," BROADCAST theta"
14115 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
14117 ! write (iout,*) "Processor",myrank," BROADCAST phi"
14118 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
14120 ! write (iout,*) "Processor",myrank," BROADCAST alph"
14121 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
14123 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
14124 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
14126 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
14127 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
14129 time_Bcast=time_Bcast+MPI_Wtime()-time00
14130 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
14132 ! write (iout,*) 'Processor',myrank,
14133 ! & ' calling etotal_short ipot=',ipot
14135 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
14137 ! call int_from_cart1(.false.)
14139 ! Compute the side-chain and electrostatic interaction energy
14141 goto (101,102,103,104,105,106) ipot
14142 ! Lennard-Jones potential.
14143 101 call elj_short(evdw)
14144 !d print '(a)','Exit ELJ'
14146 ! Lennard-Jones-Kihara potential (shifted).
14147 102 call eljk_short(evdw)
14149 ! Berne-Pechukas potential (dilated LJ, angular dependence).
14150 103 call ebp_short(evdw)
14152 ! Gay-Berne potential (shifted LJ, angular dependence).
14153 104 call egb_short(evdw)
14155 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
14156 105 call egbv_short(evdw)
14158 ! Soft-sphere potential - already dealt with in the long-range part
14160 ! 106 call e_softsphere_short(evdw)
14162 ! Calculate electrostatic (H-bonding) energy of the main chain.
14166 ! Calculate the short-range part of Evdwpp
14168 call evdwpp_short(evdw1)
14170 ! Calculate the short-range part of ESCp
14172 if (ipot.lt.6) then
14173 call escp_short(evdw2,evdw2_14)
14176 ! Calculate the bond-stretching energy
14180 ! Calculate the disulfide-bridge and other energy and the contributions
14181 ! from other distance constraints.
14184 ! Calculate the virtual-bond-angle energy.
14188 ! Calculate the SC local energy.
14193 ! Calculate the virtual-bond torsional energy.
14195 call etor(etors,edihcnstr)
14197 ! 6/23/01 Calculate double-torsional energy
14199 call etor_d(etors_d)
14201 ! 21/5/07 Calculate local sicdechain correlation energy
14203 if (wsccor.gt.0.0d0) then
14204 call eback_sc_corr(esccor)
14209 ! Put energy components into an array
14216 energia(2)=evdw2-evdw2_14
14217 energia(18)=evdw2_14
14230 energia(14)=etors_d
14233 energia(19)=edihcnstr
14235 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
14237 call sum_energy(energia,.true.)
14238 ! write (iout,*) "Exit ETOTAL_SHORT"
14241 end subroutine etotal_short
14242 !-----------------------------------------------------------------------------
14244 !-----------------------------------------------------------------------------
14245 real(kind=8) function gnmr1(y,ymin,ymax)
14247 real(kind=8) :: y,ymin,ymax
14248 real(kind=8) :: wykl=4.0d0
14249 if (y.lt.ymin) then
14250 gnmr1=(ymin-y)**wykl/wykl
14251 else if (y.gt.ymax) then
14252 gnmr1=(y-ymax)**wykl/wykl
14258 !-----------------------------------------------------------------------------
14259 real(kind=8) function gnmr1prim(y,ymin,ymax)
14261 real(kind=8) :: y,ymin,ymax
14262 real(kind=8) :: wykl=4.0d0
14263 if (y.lt.ymin) then
14264 gnmr1prim=-(ymin-y)**(wykl-1)
14265 else if (y.gt.ymax) then
14266 gnmr1prim=(y-ymax)**(wykl-1)
14271 end function gnmr1prim
14272 !-----------------------------------------------------------------------------
14273 real(kind=8) function harmonic(y,ymax)
14275 real(kind=8) :: y,ymax
14276 real(kind=8) :: wykl=2.0d0
14277 harmonic=(y-ymax)**wykl
14279 end function harmonic
14280 !-----------------------------------------------------------------------------
14281 real(kind=8) function harmonicprim(y,ymax)
14282 real(kind=8) :: y,ymin,ymax
14283 real(kind=8) :: wykl=2.0d0
14284 harmonicprim=(y-ymax)*wykl
14286 end function harmonicprim
14287 !-----------------------------------------------------------------------------
14289 !-----------------------------------------------------------------------------
14290 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
14292 use io_base, only:intout,briefout
14293 ! implicit real*8 (a-h,o-z)
14294 ! include 'DIMENSIONS'
14295 ! include 'COMMON.CHAIN'
14296 ! include 'COMMON.DERIV'
14297 ! include 'COMMON.VAR'
14298 ! include 'COMMON.INTERACT'
14299 ! include 'COMMON.FFIELD'
14300 ! include 'COMMON.MD'
14301 ! include 'COMMON.IOUNITS'
14302 real(kind=8),external :: ufparm
14303 integer :: uiparm(1)
14304 real(kind=8) :: urparm(1)
14305 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
14306 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
14307 integer :: n,nf,ind,ind1,i,k,j
14309 ! This subroutine calculates total internal coordinate gradient.
14310 ! Depending on the number of function evaluations, either whole energy
14311 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
14312 ! internal coordinates are reevaluated or only the cartesian-in-internal
14313 ! coordinate derivatives are evaluated. The subroutine was designed to work
14319 !d print *,'grad',nf,icg
14320 if (nf-nfl+1) 20,30,40
14321 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
14322 ! write (iout,*) 'grad 20'
14323 if (nf.eq.0) return
14325 30 call var_to_geom(n,x)
14327 ! write (iout,*) 'grad 30'
14329 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
14332 ! write (iout,*) 'grad 40'
14333 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
14335 ! Convert the Cartesian gradient into internal-coordinate gradient.
14345 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
14347 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
14350 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
14356 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
14358 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
14359 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
14362 if (i.gt.1) g(i-1)=gphii
14363 if (n.gt.nphi) g(nphi+i)=gthetai
14365 if (n.le.nphi+ntheta) goto 10
14367 if (itype(i).ne.10) then
14371 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
14374 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
14376 g(ialph(i,1))=galphai
14377 g(ialph(i,1)+nside)=gomegai
14381 ! Add the components corresponding to local energy terms.
14385 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
14386 g(i)=g(i)+gloc(i,icg)
14388 ! Uncomment following three lines for diagnostics.
14390 !elwrite(iout,*) "in gradient after calling intout"
14391 !d call briefout(0,0.0d0)
14392 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
14394 end subroutine gradient
14395 !-----------------------------------------------------------------------------
14396 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
14399 ! implicit real*8 (a-h,o-z)
14400 ! include 'DIMENSIONS'
14401 ! include 'COMMON.DERIV'
14402 ! include 'COMMON.IOUNITS'
14403 ! include 'COMMON.GEO'
14406 !el common /chuju/ jjj
14407 real(kind=8) :: energia(0:n_ene)
14408 integer :: uiparm(1)
14409 real(kind=8) :: urparm(1)
14411 real(kind=8),external :: ufparm
14412 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
14413 ! if (jjj.gt.0) then
14414 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
14418 !d print *,'func',nf,nfl,icg
14419 call var_to_geom(n,x)
14422 !d write (iout,*) 'ETOTAL called from FUNC'
14423 call etotal(energia)
14426 ! if (jjj.gt.0) then
14427 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
14428 ! write (iout,*) 'f=',etot
14432 end subroutine func
14433 !-----------------------------------------------------------------------------
14434 subroutine cartgrad
14435 ! implicit real*8 (a-h,o-z)
14436 ! include 'DIMENSIONS'
14438 use MD_data, only: totT,usampl,eq_time
14442 ! include 'COMMON.CHAIN'
14443 ! include 'COMMON.DERIV'
14444 ! include 'COMMON.VAR'
14445 ! include 'COMMON.INTERACT'
14446 ! include 'COMMON.FFIELD'
14447 ! include 'COMMON.MD'
14448 ! include 'COMMON.IOUNITS'
14449 ! include 'COMMON.TIME1'
14453 ! This subrouting calculates total Cartesian coordinate gradient.
14454 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
14464 !el write (iout,*) "After sum_gradient"
14466 !el write (iout,*) "After sum_gradient"
14468 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
14469 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
14472 ! If performing constraint dynamics, add the gradients of the constraint energy
14473 if(usampl.and.totT.gt.eq_time) then
14476 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
14477 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
14481 gloc(i,icg)=gloc(i,icg)+dugamma(i)
14484 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
14487 !elwrite (iout,*) "After sum_gradient"
14492 !elwrite (iout,*) "After sum_gradient"
14494 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
14496 ! call checkintcartgrad
14497 ! write(iout,*) 'calling int_to_cart'
14499 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
14503 gcart(j,i)=gradc(j,i,icg)
14504 gxcart(j,i)=gradx(j,i,icg)
14507 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
14508 (gxcart(j,i),j=1,3),gloc(i,icg)
14516 time_inttocart=time_inttocart+MPI_Wtime()-time01
14519 write (iout,*) "gcart and gxcart after int_to_cart"
14521 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
14522 (gxcart(j,i),j=1,3)
14527 write (iout,*) "CARGRAD"
14531 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
14532 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
14534 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
14535 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
14537 ! Correction: dummy residues
14540 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
14541 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
14544 if (nct.lt.nres) then
14546 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
14547 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
14552 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
14556 end subroutine cartgrad
14557 !-----------------------------------------------------------------------------
14558 subroutine zerograd
14559 ! implicit real*8 (a-h,o-z)
14560 ! include 'DIMENSIONS'
14561 ! include 'COMMON.DERIV'
14562 ! include 'COMMON.CHAIN'
14563 ! include 'COMMON.VAR'
14564 ! include 'COMMON.MD'
14565 ! include 'COMMON.SCCOR'
14567 !el local variables
14568 integer :: i,j,intertyp
14569 ! Initialize Cartesian-coordinate gradient
14571 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
14572 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
14574 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
14575 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
14576 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
14577 ! allocate(gradcorr_long(3,nres))
14578 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
14579 ! allocate(gcorr6_turn_long(3,nres))
14580 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
14582 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
14584 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
14585 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
14587 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
14588 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
14590 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
14591 ! allocate(gscloc(3,nres)) !(3,maxres)
14592 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
14596 ! common /deriv_scloc/
14597 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
14598 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
14599 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
14601 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
14605 ! gradc(j,i,icg)=0.0d0
14606 ! gradx(j,i,icg)=0.0d0
14608 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
14609 !elwrite(iout,*) "icg",icg
14613 gradx_scp(j,i)=0.0D0
14615 gvdwc_scp(j,i)=0.0D0
14616 gvdwc_scpp(j,i)=0.0d0
14618 gelc_long(j,i)=0.0D0
14623 gel_loc_long(j,i)=0.0d0
14626 gcorr3_turn(j,i)=0.0d0
14627 gcorr4_turn(j,i)=0.0d0
14628 gradcorr(j,i)=0.0d0
14629 gradcorr_long(j,i)=0.0d0
14630 gradcorr5_long(j,i)=0.0d0
14631 gradcorr6_long(j,i)=0.0d0
14632 gcorr6_turn_long(j,i)=0.0d0
14633 gradcorr5(j,i)=0.0d0
14634 gradcorr6(j,i)=0.0d0
14635 gcorr6_turn(j,i)=0.0d0
14638 gradc(j,i,icg)=0.0d0
14639 gradx(j,i,icg)=0.0d0
14643 gloc_sc(intertyp,i,icg)=0.0d0
14648 ! Initialize the gradient of local energy terms.
14650 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
14651 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
14652 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
14653 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
14654 ! allocate(gel_loc_turn3(nres))
14655 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
14656 ! allocate(gsccor_loc(nres)) !(maxres)
14662 gel_loc_loc(i)=0.0d0
14664 g_corr5_loc(i)=0.0d0
14665 g_corr6_loc(i)=0.0d0
14666 gel_loc_turn3(i)=0.0d0
14667 gel_loc_turn4(i)=0.0d0
14668 gel_loc_turn6(i)=0.0d0
14669 gsccor_loc(i)=0.0d0
14671 ! initialize gcart and gxcart
14672 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
14680 end subroutine zerograd
14681 !-----------------------------------------------------------------------------
14682 real(kind=8) function fdum()
14686 !-----------------------------------------------------------------------------
14688 !-----------------------------------------------------------------------------
14689 subroutine intcartderiv
14690 ! implicit real*8 (a-h,o-z)
14691 ! include 'DIMENSIONS'
14695 ! include 'COMMON.SETUP'
14696 ! include 'COMMON.CHAIN'
14697 ! include 'COMMON.VAR'
14698 ! include 'COMMON.GEO'
14699 ! include 'COMMON.INTERACT'
14700 ! include 'COMMON.DERIV'
14701 ! include 'COMMON.IOUNITS'
14702 ! include 'COMMON.LOCAL'
14703 ! include 'COMMON.SCCOR'
14704 real(kind=8) :: pi4,pi34
14705 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
14706 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
14707 dcosomega,dsinomega !(3,3,maxres)
14708 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
14711 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
14712 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
14713 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
14714 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
14718 !el from module energy-------------
14719 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
14720 !el allocate(dsintau(3,3,3,itau_start:itau_end))
14721 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
14723 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
14724 !el allocate(dsintau(3,3,3,0:nres2))
14725 !el allocate(dtauangle(3,3,3,0:nres2))
14726 !el allocate(domicron(3,2,2,0:nres2))
14727 !el allocate(dcosomicron(3,2,2,0:nres2))
14731 #if defined(MPI) && defined(PARINTDER)
14732 if (nfgtasks.gt.1 .and. me.eq.king) &
14733 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
14738 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
14739 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
14741 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
14744 dtheta(j,1,i)=0.0d0
14745 dtheta(j,2,i)=0.0d0
14751 ! Derivatives of theta's
14752 #if defined(MPI) && defined(PARINTDER)
14753 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
14754 do i=max0(ithet_start-1,3),ithet_end
14758 cost=dcos(theta(i))
14759 sint=sqrt(1-cost*cost)
14761 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
14763 if (itype(i-1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
14764 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
14766 if (itype(i-1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
14769 #if defined(MPI) && defined(PARINTDER)
14770 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
14771 do i=max0(ithet_start-1,3),ithet_end
14775 if ((itype(i-1).ne.10).and.(itype(i-1).ne.ntyp1)) then
14776 cost1=dcos(omicron(1,i))
14777 sint1=sqrt(1-cost1*cost1)
14778 cost2=dcos(omicron(2,i))
14779 sint2=sqrt(1-cost2*cost2)
14781 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
14782 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
14783 cost1*dc_norm(j,i-2))/ &
14785 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
14786 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
14787 +cost1*(dc_norm(j,i-1+nres)))/ &
14789 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
14790 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
14791 !C Looks messy but better than if in loop
14792 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
14793 +cost2*dc_norm(j,i-1))/ &
14795 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
14796 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
14797 +cost2*(-dc_norm(j,i-1+nres)))/ &
14799 ! write(iout,*) "vbld", i,itype(i),vbld(i-1+nres)
14800 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
14804 !elwrite(iout,*) "after vbld write"
14805 ! Derivatives of phi:
14806 ! If phi is 0 or 180 degrees, then the formulas
14807 ! have to be derived by power series expansion of the
14808 ! conventional formulas around 0 and 180.
14810 do i=iphi1_start,iphi1_end
14814 ! if (itype(i-1).eq.21 .or. itype(i-2).eq.21 ) cycle
14815 ! the conventional case
14816 sint=dsin(theta(i))
14817 sint1=dsin(theta(i-1))
14819 cost=dcos(theta(i))
14820 cost1=dcos(theta(i-1))
14822 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
14823 fac0=1.0d0/(sint1*sint)
14826 fac3=cosg*cost1/(sint1*sint1)
14827 fac4=cosg*cost/(sint*sint)
14828 ! Obtaining the gamma derivatives from sine derivative
14829 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
14830 phi(i).gt.pi34.and.phi(i).le.pi.or. &
14831 phi(i).ge.-pi.and.phi(i).le.-pi34) then
14832 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
14833 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
14834 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
14838 cosg_inv=1.0d0/cosg
14839 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
14840 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
14841 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
14842 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
14844 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
14845 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14846 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
14847 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
14848 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
14849 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14850 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
14852 ! Bug fixed 3/24/05 (AL)
14854 ! Obtaining the gamma derivatives from cosine derivative
14857 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
14858 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
14859 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
14860 dc_norm(j,i-3))/vbld(i-2)
14861 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
14862 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
14863 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
14865 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
14866 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
14867 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
14868 dc_norm(j,i-1))/vbld(i)
14869 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
14874 !alculate derivative of Tauangle
14876 do i=itau_start,itau_end
14879 !elwrite(iout,*) " vecpr",i,nres
14881 if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
14882 ! if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10).or.
14883 ! & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1)) cycle
14884 !c dtauangle(j,intertyp,dervityp,residue number)
14885 !c INTERTYP=1 SC...Ca...Ca..Ca
14886 ! the conventional case
14887 sint=dsin(theta(i))
14888 sint1=dsin(omicron(2,i-1))
14889 sing=dsin(tauangle(1,i))
14890 cost=dcos(theta(i))
14891 cost1=dcos(omicron(2,i-1))
14892 cosg=dcos(tauangle(1,i))
14893 !elwrite(iout,*) " vecpr5",i,nres
14895 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
14896 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
14897 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
14898 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
14900 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
14901 fac0=1.0d0/(sint1*sint)
14904 fac3=cosg*cost1/(sint1*sint1)
14905 fac4=cosg*cost/(sint*sint)
14906 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
14907 ! Obtaining the gamma derivatives from sine derivative
14908 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
14909 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
14910 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
14911 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
14912 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
14913 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
14917 cosg_inv=1.0d0/cosg
14918 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
14919 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
14920 *vbld_inv(i-2+nres)
14921 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
14922 dsintau(j,1,2,i)= &
14923 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
14924 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14925 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
14926 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
14927 ! Bug fixed 3/24/05 (AL)
14928 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
14929 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
14930 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
14931 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
14933 ! Obtaining the gamma derivatives from cosine derivative
14936 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
14937 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
14938 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
14939 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
14940 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
14941 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
14943 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
14944 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
14945 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
14946 dc_norm(j,i-1))/vbld(i)
14947 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
14948 ! write (iout,*) "else",i
14952 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
14955 !C Second case Ca...Ca...Ca...SC
14957 do i=itau_start,itau_end
14961 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
14962 (itype(i-2).eq.ntyp1).or.(itype(i-3).eq.ntyp1)) cycle
14963 ! the conventional case
14964 sint=dsin(omicron(1,i))
14965 sint1=dsin(theta(i-1))
14966 sing=dsin(tauangle(2,i))
14967 cost=dcos(omicron(1,i))
14968 cost1=dcos(theta(i-1))
14969 cosg=dcos(tauangle(2,i))
14971 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
14973 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
14974 fac0=1.0d0/(sint1*sint)
14977 fac3=cosg*cost1/(sint1*sint1)
14978 fac4=cosg*cost/(sint*sint)
14979 ! Obtaining the gamma derivatives from sine derivative
14980 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
14981 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
14982 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
14983 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
14984 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
14985 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
14989 cosg_inv=1.0d0/cosg
14990 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
14991 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
14992 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
14993 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
14994 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
14995 dsintau(j,2,2,i)= &
14996 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
14997 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
14998 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
14999 ! & sing*ctgt*domicron(j,1,2,i),
15000 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
15001 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
15002 ! Bug fixed 3/24/05 (AL)
15003 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
15004 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
15005 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
15006 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
15008 ! Obtaining the gamma derivatives from cosine derivative
15011 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
15012 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
15013 dc_norm(j,i-3))/vbld(i-2)
15014 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
15015 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
15016 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
15017 dcosomicron(j,1,1,i)
15018 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
15019 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
15020 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
15021 dc_norm(j,i-1+nres))/vbld(i-1+nres)
15022 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
15023 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
15028 !CC third case SC...Ca...Ca...SC
15031 do i=itau_start,itau_end
15035 ! the conventional case
15036 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
15037 (itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
15038 sint=dsin(omicron(1,i))
15039 sint1=dsin(omicron(2,i-1))
15040 sing=dsin(tauangle(3,i))
15041 cost=dcos(omicron(1,i))
15042 cost1=dcos(omicron(2,i-1))
15043 cosg=dcos(tauangle(3,i))
15045 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
15046 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
15048 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
15049 fac0=1.0d0/(sint1*sint)
15052 fac3=cosg*cost1/(sint1*sint1)
15053 fac4=cosg*cost/(sint*sint)
15054 ! Obtaining the gamma derivatives from sine derivative
15055 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
15056 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
15057 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
15058 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
15059 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
15060 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
15064 cosg_inv=1.0d0/cosg
15065 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
15066 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
15067 *vbld_inv(i-2+nres)
15068 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
15069 dsintau(j,3,2,i)= &
15070 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
15071 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
15072 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
15073 ! Bug fixed 3/24/05 (AL)
15074 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
15075 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
15076 *vbld_inv(i-1+nres)
15077 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
15078 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
15080 ! Obtaining the gamma derivatives from cosine derivative
15083 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
15084 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
15085 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
15086 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
15087 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
15088 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
15089 dcosomicron(j,1,1,i)
15090 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
15091 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
15092 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
15093 dc_norm(j,i-1+nres))/vbld(i-1+nres)
15094 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
15095 ! write(iout,*) "else",i
15101 ! Derivatives of side-chain angles alpha and omega
15102 #if defined(MPI) && defined(PARINTDER)
15103 do i=ibond_start,ibond_end
15107 if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then
15108 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
15111 fac8=fac5/vbld(i+1)
15112 fac9=fac5/vbld(i+nres)
15113 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
15114 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
15115 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
15116 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
15117 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
15118 sina=sqrt(1-cosa*cosa)
15120 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
15122 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
15123 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
15124 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
15125 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
15126 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
15127 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
15128 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
15129 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
15131 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
15133 ! obtaining the derivatives of omega from sines
15134 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
15135 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
15136 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
15137 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
15139 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
15140 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
15141 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
15142 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
15143 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
15144 coso_inv=1.0d0/dcos(omeg(i))
15146 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
15147 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
15148 (sino*dc_norm(j,i-1))/vbld(i)
15149 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
15150 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
15151 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
15152 -sino*dc_norm(j,i)/vbld(i+1)
15153 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
15154 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
15155 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
15157 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
15160 ! obtaining the derivatives of omega from cosines
15161 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
15162 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
15167 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
15168 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
15169 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
15170 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
15171 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
15172 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
15173 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
15174 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
15175 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
15176 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
15177 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
15178 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
15179 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
15180 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
15181 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
15187 dalpha(k,j,i)=0.0d0
15188 domega(k,j,i)=0.0d0
15194 #if defined(MPI) && defined(PARINTDER)
15195 if (nfgtasks.gt.1) then
15197 !d write (iout,*) "Gather dtheta"
15198 !d call flush(iout)
15199 write (iout,*) "dtheta before gather"
15201 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
15204 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
15205 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
15206 king,FG_COMM,IERROR)
15208 !d write (iout,*) "Gather dphi"
15209 !d call flush(iout)
15210 write (iout,*) "dphi before gather"
15212 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
15215 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
15216 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
15217 king,FG_COMM,IERROR)
15218 !d write (iout,*) "Gather dalpha"
15219 !d call flush(iout)
15221 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
15222 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
15223 king,FG_COMM,IERROR)
15224 !d write (iout,*) "Gather domega"
15225 !d call flush(iout)
15226 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
15227 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
15228 king,FG_COMM,IERROR)
15233 write (iout,*) "dtheta after gather"
15235 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
15237 write (iout,*) "dphi after gather"
15239 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
15241 write (iout,*) "dalpha after gather"
15243 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
15245 write (iout,*) "domega after gather"
15247 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
15251 end subroutine intcartderiv
15252 !-----------------------------------------------------------------------------
15253 subroutine checkintcartgrad
15254 ! implicit real*8 (a-h,o-z)
15255 ! include 'DIMENSIONS'
15259 ! include 'COMMON.CHAIN'
15260 ! include 'COMMON.VAR'
15261 ! include 'COMMON.GEO'
15262 ! include 'COMMON.INTERACT'
15263 ! include 'COMMON.DERIV'
15264 ! include 'COMMON.IOUNITS'
15265 ! include 'COMMON.SETUP'
15266 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
15267 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
15268 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
15269 real(kind=8),dimension(3) :: dc_norm_s
15270 real(kind=8) :: aincr=1.0d-5
15272 real(kind=8) :: dcji
15275 theta_s(i)=theta(i)
15279 ! Check theta gradient
15281 "Analytical (upper) and numerical (lower) gradient of theta"
15286 dc(j,i-2)=dcji+aincr
15287 call chainbuild_cart
15288 call int_from_cart1(.false.)
15289 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
15292 dc(j,i-1)=dc(j,i-1)+aincr
15293 call chainbuild_cart
15294 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
15297 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
15298 !el (dtheta(j,2,i),j=1,3)
15299 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
15300 !el (dthetanum(j,2,i),j=1,3)
15301 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
15302 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
15303 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
15306 ! Check gamma gradient
15308 "Analytical (upper) and numerical (lower) gradient of gamma"
15312 dc(j,i-3)=dcji+aincr
15313 call chainbuild_cart
15314 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
15317 dc(j,i-2)=dcji+aincr
15318 call chainbuild_cart
15319 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
15322 dc(j,i-1)=dc(j,i-1)+aincr
15323 call chainbuild_cart
15324 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
15327 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
15328 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
15329 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
15330 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
15331 !el write (iout,'(5x,3(3f10.5,5x))') &
15332 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
15333 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
15334 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
15337 ! Check alpha gradient
15339 "Analytical (upper) and numerical (lower) gradient of alpha"
15341 if(itype(i).ne.10) then
15344 dc(j,i-1)=dcji+aincr
15345 call chainbuild_cart
15346 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
15351 call chainbuild_cart
15352 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
15356 dc(j,i+nres)=dc(j,i+nres)+aincr
15357 call chainbuild_cart
15358 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
15363 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
15364 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
15365 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
15366 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
15367 !el write (iout,'(5x,3(3f10.5,5x))') &
15368 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
15369 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
15370 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
15373 ! Check omega gradient
15375 "Analytical (upper) and numerical (lower) gradient of omega"
15377 if(itype(i).ne.10) then
15380 dc(j,i-1)=dcji+aincr
15381 call chainbuild_cart
15382 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
15387 call chainbuild_cart
15388 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
15392 dc(j,i+nres)=dc(j,i+nres)+aincr
15393 call chainbuild_cart
15394 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
15399 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
15400 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
15401 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
15402 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
15403 !el write (iout,'(5x,3(3f10.5,5x))') &
15404 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
15405 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
15406 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
15410 end subroutine checkintcartgrad
15411 !-----------------------------------------------------------------------------
15413 !-----------------------------------------------------------------------------
15414 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
15415 ! implicit real*8 (a-h,o-z)
15416 ! include 'DIMENSIONS'
15417 ! include 'COMMON.IOUNITS'
15418 ! include 'COMMON.CHAIN'
15419 ! include 'COMMON.INTERACT'
15420 ! include 'COMMON.VAR'
15421 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
15422 integer :: kkk,nsep=3
15423 real(kind=8) :: qm !dist,
15424 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
15425 logical :: lprn=.false.
15427 ! real(kind=8) :: sigm,x
15429 !el sigm(x)=0.25d0*x ! local function
15435 do il=seg1+nsep,seg2
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 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
15443 if (itype(il).ne.10 .or. itype(jl).ne.10) then
15446 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
15447 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
15448 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
15449 dijCM=dist(il+nres,jl+nres)
15450 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
15452 qq = qq+qqij+qqijCM
15458 if((seg3-il).lt.3) then
15465 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
15466 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
15467 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
15469 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
15470 if (itype(il).ne.10 .or. itype(jl).ne.10) then
15473 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
15474 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
15475 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
15476 dijCM=dist(il+nres,jl+nres)
15477 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
15479 qq = qq+qqij+qqijCM
15484 if (qqmax.le.qq) qqmax=qq
15486 qwolynes=1.0d0-qqmax
15488 end function qwolynes
15489 !-----------------------------------------------------------------------------
15490 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
15491 ! implicit real*8 (a-h,o-z)
15492 ! include 'DIMENSIONS'
15493 ! include 'COMMON.IOUNITS'
15494 ! include 'COMMON.CHAIN'
15495 ! include 'COMMON.INTERACT'
15496 ! include 'COMMON.VAR'
15497 ! include 'COMMON.MD'
15498 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
15499 integer :: nsep=3, kkk
15500 !el real(kind=8) :: dist
15501 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
15502 logical :: lprn=.false.
15504 real(kind=8) :: sim,dd0,fac,ddqij
15505 !el sigm(x)=0.25d0*x ! local function
15515 do il=seg1+nsep,seg2
15518 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
15519 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
15520 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
15522 sim = 1.0d0/sigm(d0ij)
15525 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
15527 ddqij = (c(k,il)-c(k,jl))*fac
15528 dqwol(k,il)=dqwol(k,il)+ddqij
15529 dqwol(k,jl)=dqwol(k,jl)-ddqij
15532 if (itype(il).ne.10 .or. itype(jl).ne.10) then
15535 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
15536 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
15537 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
15538 dijCM=dist(il+nres,jl+nres)
15539 sim = 1.0d0/sigm(d0ijCM)
15542 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
15544 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
15545 dxqwol(k,il)=dxqwol(k,il)+ddqij
15546 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
15553 if((seg3-il).lt.3) then
15560 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
15561 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
15562 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
15564 sim = 1.0d0/sigm(d0ij)
15567 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
15569 ddqij = (c(k,il)-c(k,jl))*fac
15570 dqwol(k,il)=dqwol(k,il)+ddqij
15571 dqwol(k,jl)=dqwol(k,jl)-ddqij
15573 if (itype(il).ne.10 .or. itype(jl).ne.10) then
15576 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
15577 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
15578 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
15579 dijCM=dist(il+nres,jl+nres)
15580 sim = 1.0d0/sigm(d0ijCM)
15583 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
15585 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
15586 dxqwol(k,il)=dxqwol(k,il)+ddqij
15587 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
15596 dqwol(j,i)=dqwol(j,i)/nl
15597 dxqwol(j,i)=dxqwol(j,i)/nl
15601 end subroutine qwolynes_prim
15602 !-----------------------------------------------------------------------------
15603 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
15604 ! implicit real*8 (a-h,o-z)
15605 ! include 'DIMENSIONS'
15606 ! include 'COMMON.IOUNITS'
15607 ! include 'COMMON.CHAIN'
15608 ! include 'COMMON.INTERACT'
15609 ! include 'COMMON.VAR'
15610 integer :: seg1,seg2,seg3,seg4
15612 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
15613 real(kind=8),dimension(3,0:2*nres) :: cdummy
15614 real(kind=8) :: q1,q2
15615 real(kind=8) :: delta=1.0d-10
15620 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
15622 c(j,i)=c(j,i)+delta
15623 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
15624 qwolan(j,i)=(q2-q1)/delta
15630 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
15631 cdummy(j,i+nres)=c(j,i+nres)
15632 c(j,i+nres)=c(j,i+nres)+delta
15633 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
15634 qwolxan(j,i)=(q2-q1)/delta
15635 c(j,i+nres)=cdummy(j,i+nres)
15638 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
15640 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
15642 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
15644 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
15647 end subroutine qwol_num
15648 !-----------------------------------------------------------------------------
15649 subroutine EconstrQ
15650 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
15651 ! implicit real*8 (a-h,o-z)
15652 ! include 'DIMENSIONS'
15653 ! include 'COMMON.CONTROL'
15654 ! include 'COMMON.VAR'
15655 ! include 'COMMON.MD'
15658 ! include 'COMMON.LANGEVIN'
15660 ! include 'COMMON.LANGEVIN.lang0'
15662 ! include 'COMMON.CHAIN'
15663 ! include 'COMMON.DERIV'
15664 ! include 'COMMON.GEO'
15665 ! include 'COMMON.LOCAL'
15666 ! include 'COMMON.INTERACT'
15667 ! include 'COMMON.IOUNITS'
15668 ! include 'COMMON.NAMES'
15669 ! include 'COMMON.TIME1'
15670 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
15671 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
15673 integer :: kstart,kend,lstart,lend,idummy
15674 real(kind=8) :: delta=1.0d-7
15675 integer :: i,j,k,ii
15679 dudconst(j,i)=0.0d0
15680 duxconst(j,i)=0.0d0
15681 dudxconst(j,i)=0.0d0
15686 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
15688 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
15689 ! Calculating the derivatives of Constraint energy with respect to Q
15690 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
15692 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
15693 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
15694 ! hmnum=(hm2-hm1)/delta
15695 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
15696 ! & qinfrag(i,iset))
15697 ! write(iout,*) "harmonicnum frag", hmnum
15698 ! Calculating the derivatives of Q with respect to cartesian coordinates
15699 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
15701 ! write(iout,*) "dqwol "
15703 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
15705 ! write(iout,*) "dxqwol "
15707 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
15709 ! Calculating numerical gradients of dU/dQi and dQi/dxi
15710 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
15711 ! & ,idummy,idummy)
15712 ! The gradients of Uconst in Cs
15715 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
15716 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
15721 kstart=ifrag(1,ipair(1,i,iset),iset)
15722 kend=ifrag(2,ipair(1,i,iset),iset)
15723 lstart=ifrag(1,ipair(2,i,iset),iset)
15724 lend=ifrag(2,ipair(2,i,iset),iset)
15725 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
15726 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
15727 ! Calculating dU/dQ
15728 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
15729 ! hm1=harmonic(qpair(i),qinpair(i,iset))
15730 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
15731 ! hmnum=(hm2-hm1)/delta
15732 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
15733 ! & qinpair(i,iset))
15734 ! write(iout,*) "harmonicnum pair ", hmnum
15735 ! Calculating dQ/dXi
15736 call qwolynes_prim(kstart,kend,.false.,&
15738 ! write(iout,*) "dqwol "
15740 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
15742 ! write(iout,*) "dxqwol "
15744 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
15746 ! Calculating numerical gradients
15747 ! call qwol_num(kstart,kend,.false.
15749 ! The gradients of Uconst in Cs
15752 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
15753 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
15757 ! write(iout,*) "Uconst inside subroutine ", Uconst
15758 ! Transforming the gradients from Cs to dCs for the backbone
15762 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
15766 ! Transforming the gradients from Cs to dCs for the side chains
15769 dudxconst(j,i)=duxconst(j,i)
15772 ! write(iout,*) "dU/ddc backbone "
15774 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
15776 ! write(iout,*) "dU/ddX side chain "
15778 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
15780 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
15781 ! call dEconstrQ_num
15783 end subroutine EconstrQ
15784 !-----------------------------------------------------------------------------
15785 subroutine dEconstrQ_num
15786 ! Calculating numerical dUconst/ddc and dUconst/ddx
15787 ! implicit real*8 (a-h,o-z)
15788 ! include 'DIMENSIONS'
15789 ! include 'COMMON.CONTROL'
15790 ! include 'COMMON.VAR'
15791 ! include 'COMMON.MD'
15794 ! include 'COMMON.LANGEVIN'
15796 ! include 'COMMON.LANGEVIN.lang0'
15798 ! include 'COMMON.CHAIN'
15799 ! include 'COMMON.DERIV'
15800 ! include 'COMMON.GEO'
15801 ! include 'COMMON.LOCAL'
15802 ! include 'COMMON.INTERACT'
15803 ! include 'COMMON.IOUNITS'
15804 ! include 'COMMON.NAMES'
15805 ! include 'COMMON.TIME1'
15806 real(kind=8) :: uzap1,uzap2
15807 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
15808 integer :: kstart,kend,lstart,lend,idummy
15809 real(kind=8) :: delta=1.0d-7
15810 !el local variables
15816 dUcartan(j,i)=0.0d0
15817 cdummy(j,i)=dc(j,i)
15818 dc(j,i)=dc(j,i)+delta
15819 call chainbuild_cart
15822 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15824 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
15828 kstart=ifrag(1,ipair(1,ii,iset),iset)
15829 kend=ifrag(2,ipair(1,ii,iset),iset)
15830 lstart=ifrag(1,ipair(2,ii,iset),iset)
15831 lend=ifrag(2,ipair(2,ii,iset),iset)
15832 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15833 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
15836 dc(j,i)=cdummy(j,i)
15837 call chainbuild_cart
15840 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15842 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
15846 kstart=ifrag(1,ipair(1,ii,iset),iset)
15847 kend=ifrag(2,ipair(1,ii,iset),iset)
15848 lstart=ifrag(1,ipair(2,ii,iset),iset)
15849 lend=ifrag(2,ipair(2,ii,iset),iset)
15850 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15851 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
15854 ducartan(j,i)=(uzap2-uzap1)/(delta)
15857 ! Calculating numerical gradients for dU/ddx
15859 duxcartan(j,i)=0.0d0
15861 cdummy(j,i)=dc(j,i+nres)
15862 dc(j,i+nres)=dc(j,i+nres)+delta
15863 call chainbuild_cart
15866 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
15868 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
15872 kstart=ifrag(1,ipair(1,ii,iset),iset)
15873 kend=ifrag(2,ipair(1,ii,iset),iset)
15874 lstart=ifrag(1,ipair(2,ii,iset),iset)
15875 lend=ifrag(2,ipair(2,ii,iset),iset)
15876 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15877 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
15880 dc(j,i+nres)=cdummy(j,i)
15881 call chainbuild_cart
15884 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
15885 ifrag(2,ii,iset),.true.,idummy,idummy)
15886 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
15890 kstart=ifrag(1,ipair(1,ii,iset),iset)
15891 kend=ifrag(2,ipair(1,ii,iset),iset)
15892 lstart=ifrag(1,ipair(2,ii,iset),iset)
15893 lend=ifrag(2,ipair(2,ii,iset),iset)
15894 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
15895 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
15898 duxcartan(j,i)=(uzap2-uzap1)/(delta)
15901 write(iout,*) "Numerical dUconst/ddc backbone "
15903 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
15905 ! write(iout,*) "Numerical dUconst/ddx side-chain "
15907 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
15910 end subroutine dEconstrQ_num
15911 !-----------------------------------------------------------------------------
15913 !-----------------------------------------------------------------------------
15914 subroutine check_energies
15916 ! use random, only: ran_number
15920 ! include 'DIMENSIONS'
15921 ! include 'COMMON.CHAIN'
15922 ! include 'COMMON.VAR'
15923 ! include 'COMMON.IOUNITS'
15924 ! include 'COMMON.SBRIDGE'
15925 ! include 'COMMON.LOCAL'
15926 ! include 'COMMON.GEO'
15928 ! External functions
15929 !EL double precision ran_number
15930 !EL external ran_number
15933 integer :: i,j,k,l,lmax,p,pmax
15934 real(kind=8) :: rmin,rmax
15935 real(kind=8) :: eij
15938 real(kind=8) :: wi,rij,tj,pj
15960 !t wi=ran_number(0.0D0,pi)
15961 ! wi=ran_number(0.0D0,pi/6.0D0)
15963 !t tj=ran_number(0.0D0,pi)
15964 !t pj=ran_number(0.0D0,pi)
15965 ! pj=ran_number(0.0D0,pi/6.0D0)
15969 !t rij=ran_number(rmin,rmax)
15971 c(1,j)=d*sin(pj)*cos(tj)
15972 c(2,j)=d*sin(pj)*sin(tj)
15978 c(3,i)=-rij-d*cos(wi)
15981 dc(k,nres+i)=c(k,nres+i)-c(k,i)
15982 dc_norm(k,nres+i)=dc(k,nres+i)/d
15983 dc(k,nres+j)=c(k,nres+j)-c(k,j)
15984 dc_norm(k,nres+j)=dc(k,nres+j)/d
15987 call dyn_ssbond_ene(i,j,eij)
15992 end subroutine check_energies
15993 !-----------------------------------------------------------------------------
15994 subroutine dyn_ssbond_ene(resi,resj,eij)
15999 ! include 'DIMENSIONS'
16000 ! include 'COMMON.SBRIDGE'
16001 ! include 'COMMON.CHAIN'
16002 ! include 'COMMON.DERIV'
16003 ! include 'COMMON.LOCAL'
16004 ! include 'COMMON.INTERACT'
16005 ! include 'COMMON.VAR'
16006 ! include 'COMMON.IOUNITS'
16007 ! include 'COMMON.CALC'
16011 ! include 'COMMON.MD'
16012 ! use MD, only: totT,t_bath
16015 ! External functions
16016 !EL double precision h_base
16017 !EL external h_base
16020 integer :: resi,resj
16023 real(kind=8) :: eij
16026 logical :: havebond
16027 integer itypi,itypj
16028 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
16029 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
16030 real(kind=8),dimension(3) :: dcosom1,dcosom2
16032 real(kind=8) :: pom1,pom2
16033 real(kind=8) :: ljA,ljB,ljXs
16034 real(kind=8),dimension(1:3) :: d_ljB
16035 real(kind=8) :: ssA,ssB,ssC,ssXs
16036 real(kind=8) :: ssxm,ljxm,ssm,ljm
16037 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
16038 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
16039 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
16040 !-------FIRST METHOD
16042 real(kind=8),dimension(1:3) :: d_xm
16043 !-------END FIRST METHOD
16044 !-------SECOND METHOD
16045 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
16046 !-------END SECOND METHOD
16048 !-------TESTING CODE
16049 !el logical :: checkstop,transgrad
16050 !el common /sschecks/ checkstop,transgrad
16052 integer :: icheck,nicheck,jcheck,njcheck
16053 real(kind=8),dimension(-1:1) :: echeck
16054 real(kind=8) :: deps,ssx0,ljx0
16055 !-------END TESTING CODE
16061 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
16062 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
16065 dxi=dc_norm(1,nres+i)
16066 dyi=dc_norm(2,nres+i)
16067 dzi=dc_norm(3,nres+i)
16068 dsci_inv=vbld_inv(i+nres)
16071 xj=c(1,nres+j)-c(1,nres+i)
16072 yj=c(2,nres+j)-c(2,nres+i)
16073 zj=c(3,nres+j)-c(3,nres+i)
16074 dxj=dc_norm(1,nres+j)
16075 dyj=dc_norm(2,nres+j)
16076 dzj=dc_norm(3,nres+j)
16077 dscj_inv=vbld_inv(j+nres)
16079 chi1=chi(itypi,itypj)
16080 chi2=chi(itypj,itypi)
16087 alf12=0.5D0*(alf1+alf2)
16089 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
16090 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
16091 ! The following are set in sc_angular
16095 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
16096 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
16097 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
16099 rij=1.0D0/rij ! Reset this so it makes sense
16101 sig0ij=sigma(itypi,itypj)
16102 sig=sig0ij*dsqrt(1.0D0/sigsq)
16105 ljA=eps1*eps2rt**2*eps3rt**2
16106 ljB=ljA*bb(itypi,itypj)
16107 ljA=ljA*aa(itypi,itypj)
16108 ljxm=ljXs+(-2.0D0*aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
16113 deltat12=om2-om1+2.0d0
16114 cosphi=om12-om1*om2
16118 +akth*(deltat1*deltat1+deltat2*deltat2) &
16119 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
16120 ssxm=ssXs-0.5D0*ssB/ssA
16122 !-------TESTING CODE
16123 !$$$c Some extra output
16124 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
16125 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
16126 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
16127 !$$$ if (ssx0.gt.0.0d0) then
16128 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
16132 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
16133 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
16134 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
16136 !-------END TESTING CODE
16138 !-------TESTING CODE
16139 ! Stop and plot energy and derivative as a function of distance
16140 if (checkstop) then
16141 ssm=ssC-0.25D0*ssB*ssB/ssA
16142 ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
16143 if (ssm.lt.ljm .and. &
16144 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
16152 if (.not.checkstop) then
16157 do icheck=0,nicheck
16158 do jcheck=-1,njcheck
16159 if (checkstop) rij=(ssxm-1.0d0)+ &
16160 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
16161 !-------END TESTING CODE
16163 if (rij.gt.ljxm) then
16166 fac=(1.0D0/ljd)**expon
16167 e1=fac*fac*aa(itypi,itypj)
16168 e2=fac*bb(itypi,itypj)
16169 eij=eps1*eps2rt*eps3rt*(e1+e2)
16172 eij=eij*eps2rt*eps3rt
16175 e1=e1*eps1*eps2rt**2*eps3rt**2
16176 ed=-expon*(e1+eij)/ljd
16178 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
16179 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
16180 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
16181 -2.0D0*alf12*eps3der+sigder*sigsq_om12
16182 else if (rij.lt.ssxm) then
16185 eij=ssA*ssd*ssd+ssB*ssd+ssC
16187 ed=2*akcm*ssd+akct*deltat12
16189 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
16190 eom1=-2*akth*deltat1-pom1-om2*pom2
16191 eom2= 2*akth*deltat2+pom1-om1*pom2
16194 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
16196 d_ssxm(1)=0.5D0*akct/ssA
16197 d_ssxm(2)=-d_ssxm(1)
16200 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
16201 d_ljxm(2)=d_ljxm(1)*sigsq_om2
16202 d_ljxm(3)=d_ljxm(1)*sigsq_om12
16203 d_ljxm(1)=d_ljxm(1)*sigsq_om1
16205 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
16206 xm=0.5d0*(ssxm+ljxm)
16208 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
16210 if (rij.lt.xm) then
16212 ssm=ssC-0.25D0*ssB*ssB/ssA
16213 d_ssm(1)=0.5D0*akct*ssB/ssA
16214 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
16215 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
16217 f1=(rij-xm)/(ssxm-xm)
16218 f2=(rij-ssxm)/(xm-ssxm)
16222 delta_inv=1.0d0/(xm-ssxm)
16223 deltasq_inv=delta_inv*delta_inv
16225 fac1=deltasq_inv*fac*(xm-rij)
16226 fac2=deltasq_inv*fac*(rij-ssxm)
16227 ed=delta_inv*(Ht*hd2-ssm*hd1)
16228 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
16229 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
16230 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
16233 ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
16234 d_ljm(1)=-0.5D0*bb(itypi,itypj)/aa(itypi,itypj)*ljB
16235 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
16236 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
16238 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
16239 f1=(rij-ljxm)/(xm-ljxm)
16240 f2=(rij-xm)/(ljxm-xm)
16244 delta_inv=1.0d0/(ljxm-xm)
16245 deltasq_inv=delta_inv*delta_inv
16247 fac1=deltasq_inv*fac*(ljxm-rij)
16248 fac2=deltasq_inv*fac*(rij-xm)
16249 ed=delta_inv*(ljm*hd2-Ht*hd1)
16250 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
16251 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
16252 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
16254 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
16256 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
16262 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
16263 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
16264 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
16266 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
16267 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
16268 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
16269 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
16270 !$$$ d_ssm(3)=omega
16272 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
16274 !$$$ d_ljm(k)=ljm*d_ljB(k)
16278 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
16279 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
16280 !$$$ d_ss(2)=akct*ssd
16281 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
16282 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
16285 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
16286 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
16287 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
16289 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
16290 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
16292 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
16294 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
16295 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
16296 !$$$ h1=h_base(f1,hd1)
16297 !$$$ h2=h_base(f2,hd2)
16298 !$$$ eij=ss*h1+ljf*h2
16299 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
16300 !$$$ deltasq_inv=delta_inv*delta_inv
16301 !$$$ fac=ljf*hd2-ss*hd1
16302 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
16303 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
16304 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
16305 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
16306 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
16307 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
16308 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
16310 !$$$ havebond=.false.
16311 !$$$ if (ed.gt.0.0d0) havebond=.true.
16312 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
16319 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
16320 ! write(iout,'(a15,f12.2,f8.1,2i5)')
16321 ! & "SSBOND_E_FORM",totT,t_bath,i,j
16325 dyn_ssbond_ij(i,j)=eij
16326 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
16327 dyn_ssbond_ij(i,j)=1.0d300
16330 ! write(iout,'(a15,f12.2,f8.1,2i5)')
16331 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
16336 !-------TESTING CODE
16337 !el if (checkstop) then
16338 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
16339 "CHECKSTOP",rij,eij,ed
16343 if (checkstop) then
16344 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
16347 if (checkstop) then
16351 !-------END TESTING CODE
16354 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
16355 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
16358 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
16361 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
16362 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
16363 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
16364 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
16365 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
16366 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
16370 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
16375 gvdwc(l,i)=gvdwc(l,i)-gg(l)
16376 gvdwc(l,j)=gvdwc(l,j)+gg(l)
16380 end subroutine dyn_ssbond_ene
16381 !-----------------------------------------------------------------------------
16382 real(kind=8) function h_base(x,deriv)
16383 ! A smooth function going 0->1 in range [0,1]
16384 ! It should NOT be called outside range [0,1], it will not work there.
16391 real(kind=8) :: deriv
16394 real(kind=8) :: xsq
16397 ! Two parabolas put together. First derivative zero at extrema
16398 !$$$ if (x.lt.0.5D0) then
16399 !$$$ h_base=2.0D0*x*x
16403 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
16404 !$$$ deriv=4.0D0*deriv
16407 ! Third degree polynomial. First derivative zero at extrema
16408 h_base=x*x*(3.0d0-2.0d0*x)
16409 deriv=6.0d0*x*(1.0d0-x)
16411 ! Fifth degree polynomial. First and second derivatives zero at extrema
16413 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
16415 !$$$ deriv=deriv*deriv
16416 !$$$ deriv=30.0d0*xsq*deriv
16419 end function h_base
16420 !-----------------------------------------------------------------------------
16421 subroutine dyn_set_nss
16422 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
16424 use MD_data, only: totT,t_bath
16426 ! include 'DIMENSIONS'
16430 ! include 'COMMON.SBRIDGE'
16431 ! include 'COMMON.CHAIN'
16432 ! include 'COMMON.IOUNITS'
16433 ! include 'COMMON.SETUP'
16434 ! include 'COMMON.MD'
16436 real(kind=8) :: emin
16437 integer :: i,j,imin,ierr
16438 integer :: diff,allnss,newnss
16439 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
16442 integer,dimension(0:nfgtasks) :: i_newnss
16443 integer,dimension(0:nfgtasks) :: displ
16444 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
16445 integer :: g_newnss
16450 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
16459 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
16463 if (allflag(i).eq.0 .and. &
16464 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
16465 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
16469 if (emin.lt.1.0d300) then
16472 if (allflag(i).eq.0 .and. &
16473 (allihpb(i).eq.allihpb(imin) .or. &
16474 alljhpb(i).eq.allihpb(imin) .or. &
16475 allihpb(i).eq.alljhpb(imin) .or. &
16476 alljhpb(i).eq.alljhpb(imin))) then
16483 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
16487 if (allflag(i).eq.1) then
16489 newihpb(newnss)=allihpb(i)
16490 newjhpb(newnss)=alljhpb(i)
16495 if (nfgtasks.gt.1)then
16497 call MPI_Reduce(newnss,g_newnss,1,&
16498 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
16499 call MPI_Gather(newnss,1,MPI_INTEGER,&
16500 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
16502 do i=1,nfgtasks-1,1
16503 displ(i)=i_newnss(i-1)+displ(i-1)
16505 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
16506 g_newihpb,i_newnss,displ,MPI_INTEGER,&
16508 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
16509 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
16511 if(fg_rank.eq.0) then
16512 ! print *,'g_newnss',g_newnss
16513 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
16514 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
16517 newihpb(i)=g_newihpb(i)
16518 newjhpb(i)=g_newjhpb(i)
16526 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
16531 if (idssb(i).eq.newihpb(j) .and. &
16532 jdssb(i).eq.newjhpb(j)) found=.true.
16536 if (.not.found.and.fg_rank.eq.0) &
16537 write(iout,'(a15,f12.2,f8.1,2i5)') &
16538 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
16546 if (newihpb(i).eq.idssb(j) .and. &
16547 newjhpb(i).eq.jdssb(j)) found=.true.
16551 if (.not.found.and.fg_rank.eq.0) &
16552 write(iout,'(a15,f12.2,f8.1,2i5)') &
16553 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
16560 idssb(i)=newihpb(i)
16561 jdssb(i)=newjhpb(i)
16565 end subroutine dyn_set_nss
16566 !-----------------------------------------------------------------------------
16568 subroutine read_ssHist
16571 ! include 'DIMENSIONS'
16572 ! include "DIMENSIONS.FREE"
16573 ! include 'COMMON.FREE'
16576 character(len=80) :: controlcard
16579 call card_concat(controlcard,.true.)
16580 read(controlcard,*) &
16581 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
16585 end subroutine read_ssHist
16587 !-----------------------------------------------------------------------------
16588 integer function indmat(i,j)
16590 ! get the position of the jth ijth fragment of the chain coordinate system
16591 ! in the fromto array.
16594 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
16596 end function indmat
16597 !-----------------------------------------------------------------------------
16598 real(kind=8) function sigm(x)
16604 !-----------------------------------------------------------------------------
16605 !-----------------------------------------------------------------------------
16606 subroutine alloc_ener_arrays
16607 !EL Allocation of arrays used by module energy
16608 use MD_data, only: mset
16609 !el local variables
16612 if(nres.lt.100) then
16614 elseif(nres.lt.200) then
16615 maxconts=0.8*nres ! Max. number of contacts per residue
16617 maxconts=0.6*nres ! (maxconts=maxres/4)
16619 maxcont=12*nres ! Max. number of SC contacts
16620 maxvar=6*nres ! Max. number of variables
16621 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
16622 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
16623 !----------------------
16624 ! arrays in subroutine init_int_table
16626 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
16627 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
16629 allocate(nint_gr(nres))
16630 allocate(nscp_gr(nres))
16631 allocate(ielstart(nres))
16632 allocate(ielend(nres))
16634 allocate(istart(nres,maxint_gr))
16635 allocate(iend(nres,maxint_gr))
16636 !(maxres,maxint_gr)
16637 allocate(iscpstart(nres,maxint_gr))
16638 allocate(iscpend(nres,maxint_gr))
16639 !(maxres,maxint_gr)
16640 allocate(ielstart_vdw(nres))
16641 allocate(ielend_vdw(nres))
16644 allocate(lentyp(0:nfgtasks-1))
16646 !----------------------
16648 ! common /contacts/
16649 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
16650 allocate(icont(2,maxcont))
16652 ! common /contacts1/
16653 allocate(num_cont(0:nres+4))
16655 allocate(jcont(maxconts,nres))
16657 allocate(facont(maxconts,nres))
16659 allocate(gacont(3,maxconts,nres))
16660 !(3,maxconts,maxres)
16661 ! common /contacts_hb/
16662 allocate(gacontp_hb1(3,maxconts,nres))
16663 allocate(gacontp_hb2(3,maxconts,nres))
16664 allocate(gacontp_hb3(3,maxconts,nres))
16665 allocate(gacontm_hb1(3,maxconts,nres))
16666 allocate(gacontm_hb2(3,maxconts,nres))
16667 allocate(gacontm_hb3(3,maxconts,nres))
16668 allocate(gacont_hbr(3,maxconts,nres))
16669 allocate(grij_hb_cont(3,maxconts,nres))
16670 !(3,maxconts,maxres)
16671 allocate(facont_hb(maxconts,nres))
16672 allocate(ees0p(maxconts,nres))
16673 allocate(ees0m(maxconts,nres))
16674 allocate(d_cont(maxconts,nres))
16676 allocate(num_cont_hb(nres))
16678 allocate(jcont_hb(maxconts,nres))
16681 allocate(Ug(2,2,nres))
16682 allocate(Ugder(2,2,nres))
16683 allocate(Ug2(2,2,nres))
16684 allocate(Ug2der(2,2,nres))
16686 allocate(obrot(2,nres))
16687 allocate(obrot2(2,nres))
16688 allocate(obrot_der(2,nres))
16689 allocate(obrot2_der(2,nres))
16691 ! common /precomp1/
16692 allocate(mu(2,nres))
16693 allocate(muder(2,nres))
16694 allocate(Ub2(2,nres))
16697 allocate(Ub2der(2,nres))
16698 allocate(Ctobr(2,nres))
16699 allocate(Ctobrder(2,nres))
16700 allocate(Dtobr2(2,nres))
16701 allocate(Dtobr2der(2,nres))
16703 allocate(EUg(2,2,nres))
16704 allocate(EUgder(2,2,nres))
16705 allocate(CUg(2,2,nres))
16706 allocate(CUgder(2,2,nres))
16707 allocate(DUg(2,2,nres))
16708 allocate(Dugder(2,2,nres))
16709 allocate(DtUg2(2,2,nres))
16710 allocate(DtUg2der(2,2,nres))
16712 ! common /precomp2/
16713 allocate(Ug2Db1t(2,nres))
16714 allocate(Ug2Db1tder(2,nres))
16715 allocate(CUgb2(2,nres))
16716 allocate(CUgb2der(2,nres))
16718 allocate(EUgC(2,2,nres))
16719 allocate(EUgCder(2,2,nres))
16720 allocate(EUgD(2,2,nres))
16721 allocate(EUgDder(2,2,nres))
16722 allocate(DtUg2EUg(2,2,nres))
16723 allocate(Ug2DtEUg(2,2,nres))
16725 allocate(Ug2DtEUgder(2,2,2,nres))
16726 allocate(DtUg2EUgder(2,2,2,nres))
16728 ! common /rotat_old/
16729 allocate(costab(nres))
16730 allocate(sintab(nres))
16731 allocate(costab2(nres))
16732 allocate(sintab2(nres))
16735 allocate(a_chuj(2,2,maxconts,nres))
16736 !(2,2,maxconts,maxres)(maxconts=maxres/4)
16737 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
16738 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
16739 ! common /contdistrib/
16740 allocate(ncont_sent(nres))
16741 allocate(ncont_recv(nres))
16743 allocate(iat_sent(nres))
16745 allocate(iint_sent(4,nres,nres))
16746 allocate(iint_sent_local(4,nres,nres))
16748 allocate(iturn3_sent(4,0:nres+4))
16749 allocate(iturn4_sent(4,0:nres+4))
16750 allocate(iturn3_sent_local(4,nres))
16751 allocate(iturn4_sent_local(4,nres))
16753 allocate(itask_cont_from(0:nfgtasks-1))
16754 allocate(itask_cont_to(0:nfgtasks-1))
16755 !(0:max_fg_procs-1)
16759 !----------------------
16762 allocate(dcdv(6,maxdim))
16763 allocate(dxdv(6,maxdim))
16765 allocate(dxds(6,nres))
16767 allocate(gradx(3,nres,0:2))
16768 allocate(gradc(3,nres,0:2))
16770 allocate(gvdwx(3,nres))
16771 allocate(gvdwc(3,nres))
16772 allocate(gelc(3,nres))
16773 allocate(gelc_long(3,nres))
16774 allocate(gvdwpp(3,nres))
16775 allocate(gvdwc_scpp(3,nres))
16776 allocate(gradx_scp(3,nres))
16777 allocate(gvdwc_scp(3,nres))
16778 allocate(ghpbx(3,nres))
16779 allocate(ghpbc(3,nres))
16780 allocate(gradcorr(3,nres))
16781 allocate(gradcorr_long(3,nres))
16782 allocate(gradcorr5_long(3,nres))
16783 allocate(gradcorr6_long(3,nres))
16784 allocate(gcorr6_turn_long(3,nres))
16785 allocate(gradxorr(3,nres))
16786 allocate(gradcorr5(3,nres))
16787 allocate(gradcorr6(3,nres))
16789 allocate(gloc(0:maxvar,0:2))
16790 allocate(gloc_x(0:maxvar,2))
16792 allocate(gel_loc(3,nres))
16793 allocate(gel_loc_long(3,nres))
16794 allocate(gcorr3_turn(3,nres))
16795 allocate(gcorr4_turn(3,nres))
16796 allocate(gcorr6_turn(3,nres))
16797 allocate(gradb(3,nres))
16798 allocate(gradbx(3,nres))
16800 allocate(gel_loc_loc(maxvar))
16801 allocate(gel_loc_turn3(maxvar))
16802 allocate(gel_loc_turn4(maxvar))
16803 allocate(gel_loc_turn6(maxvar))
16804 allocate(gcorr_loc(maxvar))
16805 allocate(g_corr5_loc(maxvar))
16806 allocate(g_corr6_loc(maxvar))
16808 allocate(gsccorc(3,nres))
16809 allocate(gsccorx(3,nres))
16811 allocate(gsccor_loc(nres))
16813 allocate(dtheta(3,2,nres))
16815 allocate(gscloc(3,nres))
16816 allocate(gsclocx(3,nres))
16818 allocate(dphi(3,3,nres))
16819 allocate(dalpha(3,3,nres))
16820 allocate(domega(3,3,nres))
16822 ! common /deriv_scloc/
16823 allocate(dXX_C1tab(3,nres))
16824 allocate(dYY_C1tab(3,nres))
16825 allocate(dZZ_C1tab(3,nres))
16826 allocate(dXX_Ctab(3,nres))
16827 allocate(dYY_Ctab(3,nres))
16828 allocate(dZZ_Ctab(3,nres))
16829 allocate(dXX_XYZtab(3,nres))
16830 allocate(dYY_XYZtab(3,nres))
16831 allocate(dZZ_XYZtab(3,nres))
16834 allocate(jgrad_start(nres))
16835 allocate(jgrad_end(nres))
16837 !----------------------
16840 allocate(ibond_displ(0:nfgtasks-1))
16841 allocate(ibond_count(0:nfgtasks-1))
16842 allocate(ithet_displ(0:nfgtasks-1))
16843 allocate(ithet_count(0:nfgtasks-1))
16844 allocate(iphi_displ(0:nfgtasks-1))
16845 allocate(iphi_count(0:nfgtasks-1))
16846 allocate(iphi1_displ(0:nfgtasks-1))
16847 allocate(iphi1_count(0:nfgtasks-1))
16848 allocate(ivec_displ(0:nfgtasks-1))
16849 allocate(ivec_count(0:nfgtasks-1))
16850 allocate(iset_displ(0:nfgtasks-1))
16851 allocate(iset_count(0:nfgtasks-1))
16852 allocate(iint_count(0:nfgtasks-1))
16853 allocate(iint_displ(0:nfgtasks-1))
16854 !(0:max_fg_procs-1)
16855 !----------------------
16858 allocate(gcart(3,0:nres))
16859 allocate(gxcart(3,0:nres))
16861 allocate(gradcag(3,nres))
16862 allocate(gradxag(3,nres))
16864 ! common /back_constr/
16865 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
16866 allocate(dutheta(nres))
16867 allocate(dugamma(nres))
16869 allocate(duscdiff(3,nres))
16870 allocate(duscdiffx(3,nres))
16872 !el i io:read_fragments
16873 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
16874 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
16876 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
16877 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
16878 allocate(mset(0:nprocs)) !(maxprocs/20)
16880 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
16881 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
16882 allocate(dUdconst(3,0:nres))
16883 allocate(dUdxconst(3,0:nres))
16884 allocate(dqwol(3,0:nres))
16885 allocate(dxqwol(3,0:nres))
16887 !----------------------
16889 ! common /sbridge/ in io_common: read_bridge
16890 !el allocate((:),allocatable :: iss !(maxss)
16891 ! common /links/ in io_common: read_bridge
16892 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
16893 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
16894 ! common /dyn_ssbond/
16895 ! and side-chain vectors in theta or phi.
16896 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
16900 dyn_ssbond_ij(:,:)=1.0d300
16905 allocate(idssb(nss),jdssb(nss))
16908 allocate(dyn_ss_mask(nres))
16910 dyn_ss_mask(:)=.false.
16911 !----------------------
16913 ! Parameters of the SCCOR term
16915 !el in io_conf: parmread
16916 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
16917 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
16918 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
16919 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
16920 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
16921 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
16922 ! allocate(vlor1sccor(maxterm_sccor,20,20))
16923 ! allocate(vlor2sccor(maxterm_sccor,20,20))
16924 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
16926 allocate(gloc_sc(3,0:2*nres,0:10))
16927 !(3,0:maxres2,10)maxres2=2*maxres
16928 allocate(dcostau(3,3,3,2*nres))
16929 allocate(dsintau(3,3,3,2*nres))
16930 allocate(dtauangle(3,3,3,2*nres))
16931 allocate(dcosomicron(3,3,3,2*nres))
16932 allocate(domicron(3,3,3,2*nres))
16933 !(3,3,3,maxres2)maxres2=2*maxres
16934 !----------------------
16937 allocate(varall(maxvar))
16938 !(maxvar)(maxvar=6*maxres)
16939 allocate(mask_theta(nres))
16940 allocate(mask_phi(nres))
16941 allocate(mask_side(nres))
16943 !----------------------
16946 allocate(uy(3,nres))
16947 allocate(uz(3,nres))
16949 allocate(uygrad(3,3,2,nres))
16950 allocate(uzgrad(3,3,2,nres))
16954 end subroutine alloc_ener_arrays
16955 !-----------------------------------------------------------------------------
16956 !-----------------------------------------------------------------------------