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 ! Maximum number of local shielding effectors
33 integer,parameter :: maxcontsshi=50
34 !-----------------------------------------------------------------------------
35 ! commom.calc common/calc/
36 !-----------------------------------------------------------------------------
39 ! Change 12/1/95 - common block CONTACTS1 included.
42 integer,dimension(:),allocatable :: num_cont !(maxres)
43 integer,dimension(:,:),allocatable :: jcont !(maxconts,maxres)
44 real(kind=8),dimension(:,:),allocatable :: facont,ees0plist !(maxconts,maxres)
45 real(kind=8),dimension(:,:,:),allocatable :: gacont !(3,maxconts,maxres)
46 integer,dimension(:),allocatable :: ishield_list
47 integer,dimension(:,:),allocatable :: shield_list
49 ! 12/26/95 - H-bonding contacts
50 ! common /contacts_hb/
51 real(kind=8),dimension(:,:,:),allocatable :: gacontp_hb1,gacontp_hb2,&
52 gacontp_hb3,gacontm_hb1,gacontm_hb2,gacontm_hb3,gacont_hbr,grij_hb_cont !(3,maxconts,maxres)
53 real(kind=8),dimension(:,:),allocatable :: facont_hb,ees0p,&
54 ees0m,d_cont !(maxconts,maxres)
55 integer,dimension(:),allocatable :: num_cont_hb !(maxres)
56 integer,dimension(:,:),allocatable :: jcont_hb !(maxconts,maxres)
57 ! 9/23/99 Added improper rotation matrices and matrices of dipole-dipole
59 ! 7/25/08 commented out; not needed when cumulants used
60 ! Interactions of pseudo-dipoles generated by loc-el interactions.
62 real(kind=8),dimension(:,:,:),allocatable :: dip,&
63 dipderg !(4,maxconts,maxres)
64 real(kind=8),dimension(:,:,:,:,:),allocatable :: dipderx !(3,5,4,maxconts,maxres)
65 ! 10/30/99 Added other pre-computed vectors and matrices needed
66 ! to calculate three - six-order el-loc correlation terms
68 real(kind=8),dimension(:,:,:),allocatable :: Ug,Ugder,Ug2,Ug2der !(2,2,maxres)
69 real(kind=8),dimension(:,:),allocatable :: obrot,obrot2,obrot_der,&
70 obrot2_der !(2,maxres)
72 ! This common block contains vectors and matrices dependent on a single
75 real(kind=8),dimension(:,:),allocatable :: mu,muder,Ub2,Ub2der,&
76 Ctobr,Ctobrder,Dtobr2,Dtobr2der !(2,maxres)
77 real(kind=8),dimension(:,:,:),allocatable :: EUg,EUgder,CUg,&
78 CUgder,DUg,Dugder,DtUg2,DtUg2der !(2,2,maxres)
79 ! This common block contains vectors and matrices dependent on two
80 ! consecutive amino-acid residues.
82 real(kind=8),dimension(:,:),allocatable :: Ug2Db1t,Ug2Db1tder,&
83 CUgb2,CUgb2der !(2,maxres)
84 real(kind=8),dimension(:,:,:),allocatable :: EUgC,EUgCder,&
85 EUgD,EUgDder,DtUg2EUg,Ug2DtEUg !(2,2,maxres)
86 real(kind=8),dimension(:,:,:,:),allocatable :: Ug2DtEUgder,&
87 DtUg2EUgder !(2,2,2,maxres)
89 real(kind=8),dimension(:),allocatable :: costab,sintab,&
90 costab2,sintab2 !(maxres)
91 ! This common block contains dipole-interaction matrices and their
92 ! Cartesian derivatives.
94 real(kind=8),dimension(:,:,:,:),allocatable :: a_chuj !(2,2,maxconts,maxres)
95 real(kind=8),dimension(:,:,:,:,:,:),allocatable :: a_chuj_der !(2,2,3,5,maxconts,maxres)
97 real(kind=8),dimension(2,2,2) :: AEA,AEAderg,EAEA,AECA,&
98 AECAderg,ADtEA,ADtEA1,AEAb1,AEAb1derg,AEAb2
99 real(kind=8),dimension(2,2,2,2) :: EAEAderg,ADtEAderg,&
101 real(kind=8),dimension(2,2,3,5,2,2) :: AEAderx,EAEAderx,&
102 AECAderx,ADtEAderx,ADtEA1derx
103 real(kind=8),dimension(2,3,5,2,2,2) :: AEAb1derx,AEAb2derx
104 real(kind=8),dimension(3,2) :: g_contij
105 real(kind=8) :: ekont
106 ! 12/13/2008 (again Poland-Jaruzel war anniversary)
107 ! RE: Parallelization of 4th and higher order loc-el correlations
108 ! common /contdistrib/
109 integer,dimension(:),allocatable :: ncont_sent,ncont_recv !(maxres)
110 ! ncont_sent,ncont_recv są w multibody_ello i multibody_hb
111 !-----------------------------------------------------------------------------
114 ! real(kind=8),dimension(:,:),allocatable :: dcdv,dxdv !(6,maxdim)
115 ! real(kind=8),dimension(:,:),allocatable :: dxds !(6,maxres)
116 ! real(kind=8),dimension(:,:,:),allocatable :: gradx,gradc !(3,maxres,2)
117 real(kind=8),dimension(:,:),allocatable :: gvdwc,gelc,gelc_long,&
118 gvdwpp,gvdwc_scpp,gradx_scp,gvdwc_scp,ghpbx,ghpbc,&
119 gradcorr,gradcorr_long,gradcorr5_long,gradcorr6_long,&
120 gcorr6_turn_long,gradxorr,gradcorr5,gradcorr6,gliptran,gliptranc,&
122 gshieldx,gshieldc,gshieldc_loc,gshieldx_ec,&
123 gshieldc_ec,gshieldc_loc_ec,gshieldx_t3, &
124 gshieldc_t3,gshieldc_loc_t3,gshieldx_t4,gshieldc_t4, &
125 gshieldc_loc_t4,gshieldx_ll,gshieldc_ll,gshieldc_loc_ll,&
126 grad_shield !(3,maxres)
127 ! real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2)
128 real(kind=8),dimension(:,:),allocatable :: gel_loc,gel_loc_long,&
129 gcorr3_turn,gcorr4_turn,gcorr6_turn,gradb,gradbx !(3,maxres)
130 real(kind=8),dimension(:),allocatable :: gel_loc_loc,&
131 gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc,g_corr5_loc,&
132 g_corr6_loc !(maxvar)
133 real(kind=8),dimension(:,:),allocatable :: gsccorc,gsccorx !(3,maxres)
134 real(kind=8),dimension(:),allocatable :: gsccor_loc !(maxres)
135 ! real(kind=8),dimension(:,:,:),allocatable :: dtheta !(3,2,maxres)
136 real(kind=8),dimension(:,:),allocatable :: gscloc,gsclocx !(3,maxres)
137 ! real(kind=8),dimension(:,:,:),allocatable :: dphi,dalpha,domega !(3,3,maxres)
138 real(kind=8),dimension(:,:,:),allocatable :: grad_shield_side, &
139 grad_shield_loc ! (3,maxcontsshileding,maxnres)
142 real(kind=8), dimension(:),allocatable :: fac_shield
143 real(kind=8),dimension(3,5,2) :: derx,derx_turn
144 ! common /deriv_scloc/
145 real(kind=8),dimension(:,:),allocatable :: dXX_C1tab,dYY_C1tab,&
146 dZZ_C1tab,dXX_Ctab,dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,&
147 dZZ_XYZtab !(3,maxres)
148 !-----------------------------------------------------------------------------
151 real(kind=8) :: gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,&
152 gradb_max,ghpbc_max,&
153 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
154 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
155 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
156 gsccorx_max,gsclocx_max
157 !-----------------------------------------------------------------------------
159 ! common /back_constr/
160 real(kind=8),dimension(:),allocatable :: dutheta,dugamma !(maxres)
161 real(kind=8),dimension(:,:),allocatable :: duscdiff,duscdiffx !(3,maxres)
163 real(kind=8) :: Ucdfrag,Ucdpair
164 real(kind=8),dimension(:,:),allocatable :: dUdconst,dUdxconst,&
165 dqwol,dxqwol !(3,0:MAXRES)
166 !-----------------------------------------------------------------------------
168 ! common /dyn_ssbond/
169 real(kind=8),dimension(:,:),allocatable :: dyn_ssbond_ij !(maxres,maxres)
170 !-----------------------------------------------------------------------------
172 ! Parameters of the SCCOR term
174 real(kind=8),dimension(:,:,:,:),allocatable :: dcostau,dsintau,&
175 dcosomicron,domicron !(3,3,3,maxres2)
176 !-----------------------------------------------------------------------------
179 real(kind=8),dimension(:,:),allocatable :: uy,uz !(3,maxres)
180 real(kind=8),dimension(:,:,:,:),allocatable :: uygrad,uzgrad !(3,3,2,maxres)
181 !-----------------------------------------------------------------------------
182 ! common /przechowalnia/
183 real(kind=8),dimension(:,:,:),allocatable :: zapas !(max_dim,maxconts,max_fg_procs)
184 real(kind=8),dimension(:,:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
185 !-----------------------------------------------------------------------------
186 !-----------------------------------------------------------------------------
189 !-----------------------------------------------------------------------------
191 !-----------------------------------------------------------------------------
192 ! energy_p_new_barrier.F
193 !-----------------------------------------------------------------------------
194 subroutine etotal(energia)
195 ! implicit real*8 (a-h,o-z)
196 ! include 'DIMENSIONS'
201 !MS$ATTRIBUTES C :: proc_proc
207 ! include 'COMMON.SETUP'
208 ! include 'COMMON.IOUNITS'
209 real(kind=8),dimension(0:n_ene) :: energia
210 ! include 'COMMON.LOCAL'
211 ! include 'COMMON.FFIELD'
212 ! include 'COMMON.DERIV'
213 ! include 'COMMON.INTERACT'
214 ! include 'COMMON.SBRIDGE'
215 ! include 'COMMON.CHAIN'
216 ! include 'COMMON.VAR'
217 ! include 'COMMON.MD'
218 ! include 'COMMON.CONTROL'
219 ! include 'COMMON.TIME1'
220 real(kind=8) :: time00
222 integer :: n_corr,n_corr1,ierror
223 real(kind=8) :: etors,edihcnstr,etors_d,esccor,ehpb
224 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,escloc,ees,eel_loc
225 real(kind=8) :: eello_turn3,eello_turn4,estr,ebe,eliptran
226 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
229 real(kind=8) :: weights_(n_ene) !,time_Bcast,time_Bcastw
230 ! shielding effect varibles for MPI
231 ! real(kind=8) fac_shieldbuf(maxres),
232 ! & grad_shield_locbuf(3,maxcontsshi,-1:maxres),
233 ! & grad_shield_sidebuf(3,maxcontsshi,-1:maxres),
234 ! & grad_shieldbuf(3,-1:maxres)
235 ! integer ishield_listbuf(maxres),
236 ! &shield_listbuf(maxcontsshi,maxres)
238 ! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
239 ! & " nfgtasks",nfgtasks
240 if (nfgtasks.gt.1) then
242 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
243 if (fg_rank.eq.0) then
244 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
245 ! print *,"Processor",myrank," BROADCAST iorder"
246 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
247 ! FG slaves as WEIGHTS array.
267 ! FG Master broadcasts the WEIGHTS_ array
268 call MPI_Bcast(weights_(1),n_ene,&
269 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
271 ! FG slaves receive the WEIGHTS array
272 call MPI_Bcast(weights(1),n_ene,&
273 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
294 time_Bcast=time_Bcast+MPI_Wtime()-time00
295 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
296 ! call chainbuild_cart
298 ! print *,'Processor',myrank,' calling etotal ipot=',ipot
299 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
301 ! if (modecalc.eq.12.or.modecalc.eq.14) then
302 ! call int_from_cart1(.false.)
309 ! Compute the side-chain and electrostatic interaction energy
310 print *, "Before EVDW"
311 ! goto (101,102,103,104,105,106) ipot
313 ! Lennard-Jones potential.
317 !d print '(a)','Exit ELJcall el'
319 ! Lennard-Jones-Kihara potential (shifted).
320 ! 102 call eljk(evdw)
324 ! Berne-Pechukas potential (dilated LJ, angular dependence).
329 ! Gay-Berne potential (shifted LJ, angular dependence).
334 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
335 ! 105 call egbv(evdw)
339 ! Soft-sphere potential
340 ! 106 call e_softsphere(evdw)
342 call e_softsphere(evdw)
344 ! Calculate electrostatic (H-bonding) energy of the main chain.
348 write(iout,*)"Wrong ipot"
353 ! print *,"after EGB"
355 if (shield_mode.eq.2) then
359 !mc Sep-06: egb takes care of dynamic ss bonds too
361 ! if (dyn_ss) call dyn_set_nss
362 ! print *,"Processor",myrank," computed USCSC"
368 time_vec=time_vec+MPI_Wtime()-time01
370 ! print *,"Processor",myrank," left VEC_AND_DERIV"
373 print *,"after ipot if", ipot
374 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
375 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
376 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
377 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
379 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
380 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
381 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
382 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
384 ! print *,"just befor eelec call"
385 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
386 ! write (iout,*) "ELEC calc"
395 ! write (iout,*) "Soft-spheer ELEC potential"
396 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
399 ! print *,"Processor",myrank," computed UELEC"
401 ! Calculate excluded-volume interaction energy between peptide groups
404 !elwrite(iout,*) "in etotal calc exc;luded",ipot
408 call escp(evdw2,evdw2_14)
414 ! write (iout,*) "Soft-sphere SCP potential"
415 call escp_soft_sphere(evdw2,evdw2_14)
417 ! write(iout,*) "in etotal before ebond",ipot
420 ! Calculate the bond-stretching energy
423 ! write(iout,*) "in etotal afer ebond",ipot
426 ! Calculate the disulfide-bridge and other energy and the contributions
427 ! from other distance constraints.
428 ! print *,'Calling EHPB'
430 !elwrite(iout,*) "in etotal afer edis",ipot
431 ! print *,'EHPB exitted succesfully.'
433 ! Calculate the virtual-bond-angle energy.
435 if (wang.gt.0d0) then
440 ! print *,"Processor",myrank," computed UB"
442 ! Calculate the SC local energy.
445 !elwrite(iout,*) "in etotal afer esc",ipot
446 ! print *,"Processor",myrank," computed USC"
448 ! Calculate the virtual-bond torsional energy.
450 !d print *,'nterm=',nterm
452 call etor(etors,edihcnstr)
457 ! print *,"Processor",myrank," computed Utor"
459 ! 6/23/01 Calculate double-torsional energy
461 !elwrite(iout,*) "in etotal",ipot
462 if (wtor_d.gt.0) then
467 ! print *,"Processor",myrank," computed Utord"
469 ! 21/5/07 Calculate local sicdechain correlation energy
471 if (wsccor.gt.0.0d0) then
472 call eback_sc_corr(esccor)
476 ! print *,"Processor",myrank," computed Usccorr"
478 ! 12/1/95 Multi-body terms
482 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
483 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
484 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
485 !d write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
486 !d &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
493 !elwrite(iout,*) "in etotal",ipot
494 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
495 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
496 !d write (iout,*) "multibody_hb ecorr",ecorr
498 !elwrite(iout,*) "afeter multibody hb"
500 ! print *,"Processor",myrank," computed Ucorr"
502 ! If performing constraint dynamics, call the constraint energy
503 ! after the equilibration time
504 if(usampl.and.totT.gt.eq_time) then
505 !elwrite(iout,*) "afeter multibody hb"
507 !elwrite(iout,*) "afeter multibody hb"
509 !elwrite(iout,*) "afeter multibody hb"
515 ! write(iout,*) "after Econstr"
517 if (wliptran.gt.0) then
518 ! print *,"PRZED WYWOLANIEM"
519 call Eliptransfer(eliptran)
525 time_enecalc=time_enecalc+MPI_Wtime()-time00
527 ! print *,"Processor",myrank," computed Uconstr"
536 energia(2)=evdw2-evdw2_14
553 energia(8)=eello_turn3
554 energia(9)=eello_turn4
561 energia(19)=edihcnstr
563 energia(20)=Uconst+Uconst_back
566 ! Here are the energies showed per procesor if the are more processors
567 ! per molecule then we sum it up in sum_energy subroutine
568 ! print *," Processor",myrank," calls SUM_ENERGY"
569 call sum_energy(energia,.true.)
570 if (dyn_ss) call dyn_set_nss
571 ! print *," Processor",myrank," left SUM_ENERGY"
573 time_sumene=time_sumene+MPI_Wtime()-time00
575 !el call enerprint(energia)
576 !elwrite(iout,*)"finish etotal"
578 end subroutine etotal
579 !-----------------------------------------------------------------------------
580 subroutine sum_energy(energia,reduce)
581 ! implicit real*8 (a-h,o-z)
582 ! include 'DIMENSIONS'
586 !MS$ATTRIBUTES C :: proc_proc
592 ! include 'COMMON.SETUP'
593 ! include 'COMMON.IOUNITS'
594 real(kind=8) :: energia(0:n_ene),enebuff(0:n_ene+1)
595 ! include 'COMMON.FFIELD'
596 ! include 'COMMON.DERIV'
597 ! include 'COMMON.INTERACT'
598 ! include 'COMMON.SBRIDGE'
599 ! include 'COMMON.CHAIN'
600 ! include 'COMMON.VAR'
601 ! include 'COMMON.CONTROL'
602 ! include 'COMMON.TIME1'
604 real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
605 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
606 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot, &
611 real(kind=8) :: time00
612 if (nfgtasks.gt.1 .and. reduce) then
615 write (iout,*) "energies before REDUCE"
616 call enerprint(energia)
620 enebuff(i)=energia(i)
623 call MPI_Barrier(FG_COMM,IERR)
624 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
626 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,&
627 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
629 write (iout,*) "energies after REDUCE"
630 call enerprint(energia)
633 time_Reduce=time_Reduce+MPI_Wtime()-time00
635 if (fg_rank.eq.0) then
639 evdw2=energia(2)+energia(18)
655 eello_turn3=energia(8)
656 eello_turn4=energia(9)
663 edihcnstr=energia(19)
669 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
670 +wang*ebe+wtor*etors+wscloc*escloc &
671 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
672 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
673 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
674 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
676 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
677 +wang*ebe+wtor*etors+wscloc*escloc &
678 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
679 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
680 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
681 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
687 if (isnan(etot).ne.0) energia(0)=1.0d+99
689 if (isnan(etot)) energia(0)=1.0d+99
694 idumm=proc_proc(etot,i)
696 call proc_proc(etot,i)
698 if(i.eq.1)energia(0)=1.0d+99
703 ! call enerprint(energia)
706 end subroutine sum_energy
707 !-----------------------------------------------------------------------------
708 subroutine rescale_weights(t_bath)
709 ! implicit real*8 (a-h,o-z)
713 ! include 'DIMENSIONS'
714 ! include 'COMMON.IOUNITS'
715 ! include 'COMMON.FFIELD'
716 ! include 'COMMON.SBRIDGE'
717 real(kind=8) :: kfac=2.4d0
718 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644
720 real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6
721 real(kind=8) :: T0=3.0d2
724 ! facT=2*temp0/(t_bath+temp0)
725 if (rescale_mode.eq.0) then
732 else if (rescale_mode.eq.1) then
733 facT(1)=kfac/(kfac-1.0d0+t_bath/temp0)
734 facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
735 facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
736 facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
737 facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
739 !#if defined(WHAM_RUN) || defined(CLUSTER)
741 ! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
742 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
749 else if (rescale_mode.eq.2) then
755 facT(1)=licznik/dlog(dexp(x)+dexp(-x))
756 facT(2)=licznik/dlog(dexp(x2)+dexp(-x2))
757 facT(3)=licznik/dlog(dexp(x3)+dexp(-x3))
758 facT(4)=licznik/dlog(dexp(x4)+dexp(-x4))
759 facT(5)=licznik/dlog(dexp(x5)+dexp(-x5))
761 !#if defined(WHAM_RUN) || defined(CLUSTER)
763 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
771 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
772 write (*,*) "Wrong RESCALE_MODE",rescale_mode
774 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
778 welec=weights(3)*fact(1)
779 wcorr=weights(4)*fact(3)
780 wcorr5=weights(5)*fact(4)
781 wcorr6=weights(6)*fact(5)
782 wel_loc=weights(7)*fact(2)
783 wturn3=weights(8)*fact(2)
784 wturn4=weights(9)*fact(3)
785 wturn6=weights(10)*fact(5)
786 wtor=weights(13)*fact(1)
787 wtor_d=weights(14)*fact(2)
788 wsccor=weights(21)*fact(1)
791 end subroutine rescale_weights
792 !-----------------------------------------------------------------------------
793 subroutine enerprint(energia)
794 ! implicit real*8 (a-h,o-z)
795 ! include 'DIMENSIONS'
796 ! include 'COMMON.IOUNITS'
797 ! include 'COMMON.FFIELD'
798 ! include 'COMMON.SBRIDGE'
799 ! include 'COMMON.MD'
800 real(kind=8) :: energia(0:n_ene)
802 real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
803 real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
804 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor,eliptran
810 evdw2=energia(2)+energia(18)
822 eello_turn3=energia(8)
823 eello_turn4=energia(9)
824 eello_turn6=energia(10)
830 edihcnstr=energia(19)
837 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
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,&
844 Uconst,eliptran,wliptran,etot
845 10 format (/'Virtual-chain energies:'// &
846 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
847 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
848 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
849 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ &
850 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
851 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
852 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
853 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
854 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
855 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
856 ' (SS bridges & dist. cnstr.)'/ &
857 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
858 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
859 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
860 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
861 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
862 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
863 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
864 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
865 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
866 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
867 'UCONST= ',1pE16.6,' (Constraint energy)'/ &
868 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/&
869 'ETOT= ',1pE16.6,' (total)')
871 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
872 estr,wbond,ebe,wang,&
873 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
875 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
876 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
877 ebr*nss,Uconst,eliptran,wliptran,etot
878 10 format (/'Virtual-chain energies:'// &
879 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
880 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
881 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
882 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
883 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
884 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
885 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
886 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
887 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
888 ' (SS bridges & dist. cnstr.)'/ &
889 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
890 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
891 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
892 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
893 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
894 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
895 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
896 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
897 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
898 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
899 'UCONST=',1pE16.6,' (Constraint energy)'/ &
900 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ &
901 'ETOT= ',1pE16.6,' (total)')
904 end subroutine enerprint
905 !-----------------------------------------------------------------------------
908 ! This subroutine calculates the interaction energy of nonbonded side chains
909 ! assuming the LJ potential of interaction.
911 ! implicit real*8 (a-h,o-z)
912 ! include 'DIMENSIONS'
913 real(kind=8),parameter :: accur=1.0d-10
914 ! include 'COMMON.GEO'
915 ! include 'COMMON.VAR'
916 ! include 'COMMON.LOCAL'
917 ! include 'COMMON.CHAIN'
918 ! include 'COMMON.DERIV'
919 ! include 'COMMON.INTERACT'
920 ! include 'COMMON.TORSION'
921 ! include 'COMMON.SBRIDGE'
922 ! include 'COMMON.NAMES'
923 ! include 'COMMON.IOUNITS'
924 ! include 'COMMON.CONTACTS'
925 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
928 integer :: i,itypi,iint,j,itypi1,itypj,k
929 real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
930 real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
931 real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
933 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
935 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
936 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
937 ! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
938 ! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
942 if (itypi.eq.ntyp1) cycle
943 itypi1=iabs(itype(i+1))
950 ! Calculate SC interaction energy.
953 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
954 !d & 'iend=',iend(i,iint)
955 do j=istart(i,iint),iend(i,iint)
957 if (itypj.eq.ntyp1) cycle
961 ! Change 12/1/95 to calculate four-body interactions
962 rij=xj*xj+yj*yj+zj*zj
964 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
965 eps0ij=eps(itypi,itypj)
967 e1=fac*fac*aa_aq(itypi,itypj)
968 e2=fac*bb_aq(itypi,itypj)
970 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
971 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
972 !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
973 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
974 !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
975 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
978 ! Calculate the components of the gradient in DC and X
980 fac=-rrij*(e1+evdwij)
985 gvdwx(k,i)=gvdwx(k,i)-gg(k)
986 gvdwx(k,j)=gvdwx(k,j)+gg(k)
987 gvdwc(k,i)=gvdwc(k,i)-gg(k)
988 gvdwc(k,j)=gvdwc(k,j)+gg(k)
992 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
996 ! 12/1/95, revised on 5/20/97
998 ! Calculate the contact function. The ith column of the array JCONT will
999 ! contain the numbers of atoms that make contacts with the atom I (of numbers
1000 ! greater than I). The arrays FACONT and GACONT will contain the values of
1001 ! the contact function and its derivative.
1003 ! Uncomment next line, if the correlation interactions include EVDW explicitly.
1004 ! if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1005 ! Uncomment next line, if the correlation interactions are contact function only
1006 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1008 sigij=sigma(itypi,itypj)
1009 r0ij=rs0(itypi,itypj)
1011 ! Check whether the SC's are not too far to make a contact.
1014 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1015 ! Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1017 if (fcont.gt.0.0D0) then
1018 ! If the SC-SC distance if close to sigma, apply spline.
1019 !Adam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1020 !Adam & fcont1,fprimcont1)
1021 !Adam fcont1=1.0d0-fcont1
1022 !Adam if (fcont1.gt.0.0d0) then
1023 !Adam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1024 !Adam fcont=fcont*fcont1
1026 ! Uncomment following 4 lines to have the geometric average of the epsilon0's
1027 !ga eps0ij=1.0d0/dsqrt(eps0ij)
1029 !ga gg(k)=gg(k)*eps0ij
1031 !ga eps0ij=-evdwij*eps0ij
1032 ! Uncomment for AL's type of SC correlation interactions.
1033 !adam eps0ij=-evdwij
1034 num_conti=num_conti+1
1035 jcont(num_conti,i)=j
1036 facont(num_conti,i)=fcont*eps0ij
1037 fprimcont=eps0ij*fprimcont/rij
1039 !Adam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1040 !Adam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1041 !Adam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1042 ! Uncomment following 3 lines for Skolnick's type of SC correlation.
1043 gacont(1,num_conti,i)=-fprimcont*xj
1044 gacont(2,num_conti,i)=-fprimcont*yj
1045 gacont(3,num_conti,i)=-fprimcont*zj
1046 !d write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1047 !d write (iout,'(2i3,3f10.5)')
1048 !d & i,j,(gacont(kk,num_conti,i),kk=1,3)
1054 num_cont(i)=num_conti
1058 gvdwc(j,i)=expon*gvdwc(j,i)
1059 gvdwx(j,i)=expon*gvdwx(j,i)
1062 !******************************************************************************
1066 ! To save time, the factor of EXPON has been extracted from ALL components
1067 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
1070 !******************************************************************************
1073 !-----------------------------------------------------------------------------
1074 subroutine eljk(evdw)
1076 ! This subroutine calculates the interaction energy of nonbonded side chains
1077 ! assuming the LJK potential of interaction.
1079 ! implicit real*8 (a-h,o-z)
1080 ! include 'DIMENSIONS'
1081 ! include 'COMMON.GEO'
1082 ! include 'COMMON.VAR'
1083 ! include 'COMMON.LOCAL'
1084 ! include 'COMMON.CHAIN'
1085 ! include 'COMMON.DERIV'
1086 ! include 'COMMON.INTERACT'
1087 ! include 'COMMON.IOUNITS'
1088 ! include 'COMMON.NAMES'
1089 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1092 integer :: i,iint,j,itypi,itypi1,k,itypj
1093 real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
1094 real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
1096 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1098 do i=iatsc_s,iatsc_e
1099 itypi=iabs(itype(i))
1100 if (itypi.eq.ntyp1) cycle
1101 itypi1=iabs(itype(i+1))
1106 ! Calculate SC interaction energy.
1108 do iint=1,nint_gr(i)
1109 do j=istart(i,iint),iend(i,iint)
1110 itypj=iabs(itype(j))
1111 if (itypj.eq.ntyp1) cycle
1115 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1116 fac_augm=rrij**expon
1117 e_augm=augm(itypi,itypj)*fac_augm
1118 r_inv_ij=dsqrt(rrij)
1120 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1121 fac=r_shift_inv**expon
1122 e1=fac*fac*aa_aq(itypi,itypj)
1123 e2=fac*bb_aq(itypi,itypj)
1125 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1126 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1127 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1128 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1129 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1130 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1131 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1134 ! Calculate the components of the gradient in DC and X
1136 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1141 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1142 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1143 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1144 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1148 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1156 gvdwc(j,i)=expon*gvdwc(j,i)
1157 gvdwx(j,i)=expon*gvdwx(j,i)
1162 !-----------------------------------------------------------------------------
1163 subroutine ebp(evdw)
1165 ! This subroutine calculates the interaction energy of nonbonded side chains
1166 ! assuming the Berne-Pechukas potential of interaction.
1170 ! implicit real*8 (a-h,o-z)
1171 ! include 'DIMENSIONS'
1172 ! include 'COMMON.GEO'
1173 ! include 'COMMON.VAR'
1174 ! include 'COMMON.LOCAL'
1175 ! include 'COMMON.CHAIN'
1176 ! include 'COMMON.DERIV'
1177 ! include 'COMMON.NAMES'
1178 ! include 'COMMON.INTERACT'
1179 ! include 'COMMON.IOUNITS'
1180 ! include 'COMMON.CALC'
1182 !el integer :: icall
1183 !el common /srutu/ icall
1184 ! double precision rrsave(maxdim)
1187 integer :: iint,itypi,itypi1,itypj
1188 real(kind=8) :: rrij,xi,yi,zi
1189 real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
1191 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1193 ! if (icall.eq.0) then
1199 do i=iatsc_s,iatsc_e
1200 itypi=iabs(itype(i))
1201 if (itypi.eq.ntyp1) cycle
1202 itypi1=iabs(itype(i+1))
1206 dxi=dc_norm(1,nres+i)
1207 dyi=dc_norm(2,nres+i)
1208 dzi=dc_norm(3,nres+i)
1209 ! dsci_inv=dsc_inv(itypi)
1210 dsci_inv=vbld_inv(i+nres)
1212 ! Calculate SC interaction energy.
1214 do iint=1,nint_gr(i)
1215 do j=istart(i,iint),iend(i,iint)
1217 itypj=iabs(itype(j))
1218 if (itypj.eq.ntyp1) cycle
1219 ! dscj_inv=dsc_inv(itypj)
1220 dscj_inv=vbld_inv(j+nres)
1221 chi1=chi(itypi,itypj)
1222 chi2=chi(itypj,itypi)
1229 alf12=0.5D0*(alf1+alf2)
1230 ! For diagnostics only!!!
1243 dxj=dc_norm(1,nres+j)
1244 dyj=dc_norm(2,nres+j)
1245 dzj=dc_norm(3,nres+j)
1246 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1247 !d if (icall.eq.0) then
1253 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
1255 ! Calculate whole angle-dependent part of epsilon and contributions
1256 ! to its derivatives
1257 fac=(rrij*sigsq)**expon2
1258 e1=fac*fac*aa_aq(itypi,itypj)
1259 e2=fac*bb_aq(itypi,itypj)
1260 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1261 eps2der=evdwij*eps3rt
1262 eps3der=evdwij*eps2rt
1263 evdwij=evdwij*eps2rt*eps3rt
1266 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1267 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1268 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1269 !d & restyp(itypi),i,restyp(itypj),j,
1270 !d & epsi,sigm,chi1,chi2,chip1,chip2,
1271 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1272 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
1275 ! Calculate gradient components.
1276 e1=e1*eps1*eps2rt**2*eps3rt**2
1277 fac=-expon*(e1+evdwij)
1280 ! Calculate radial part of the gradient
1284 ! Calculate the angular part of the gradient and sum add the contributions
1285 ! to the appropriate components of the Cartesian gradient.
1293 !-----------------------------------------------------------------------------
1294 subroutine egb(evdw)
1296 ! This subroutine calculates the interaction energy of nonbonded side chains
1297 ! assuming the Gay-Berne potential of interaction.
1300 ! implicit real*8 (a-h,o-z)
1301 ! include 'DIMENSIONS'
1302 ! include 'COMMON.GEO'
1303 ! include 'COMMON.VAR'
1304 ! include 'COMMON.LOCAL'
1305 ! include 'COMMON.CHAIN'
1306 ! include 'COMMON.DERIV'
1307 ! include 'COMMON.NAMES'
1308 ! include 'COMMON.INTERACT'
1309 ! include 'COMMON.IOUNITS'
1310 ! include 'COMMON.CALC'
1311 ! include 'COMMON.CONTROL'
1312 ! include 'COMMON.SBRIDGE'
1315 integer :: iint,itypi,itypi1,itypj,subchap
1316 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
1317 real(kind=8) :: evdw,sig0ij
1318 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
1319 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
1320 sslipi,sslipj,faclip
1322 real(kind=8) :: fracinbuf
1324 !cccc energy_dec=.false.
1325 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1328 ! if (icall.eq.0) lprn=.false.
1330 do i=iatsc_s,iatsc_e
1331 !C print *,"I am in EVDW",i
1332 itypi=iabs(itype(i))
1333 ! if (i.ne.47) cycle
1334 if (itypi.eq.ntyp1) cycle
1335 itypi1=iabs(itype(i+1))
1339 xi=dmod(xi,boxxsize)
1340 if (xi.lt.0) xi=xi+boxxsize
1341 yi=dmod(yi,boxysize)
1342 if (yi.lt.0) yi=yi+boxysize
1343 zi=dmod(zi,boxzsize)
1344 if (zi.lt.0) zi=zi+boxzsize
1346 if ((zi.gt.bordlipbot) &
1347 .and.(zi.lt.bordliptop)) then
1348 !C the energy transfer exist
1349 if (zi.lt.buflipbot) then
1350 !C what fraction I am in
1352 ((zi-bordlipbot)/lipbufthick)
1353 !C lipbufthick is thickenes of lipid buffore
1354 sslipi=sscalelip(fracinbuf)
1355 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1356 elseif (zi.gt.bufliptop) then
1357 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1358 sslipi=sscalelip(fracinbuf)
1359 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1368 print *, sslipi,ssgradlipi
1369 dxi=dc_norm(1,nres+i)
1370 dyi=dc_norm(2,nres+i)
1371 dzi=dc_norm(3,nres+i)
1372 ! dsci_inv=dsc_inv(itypi)
1373 dsci_inv=vbld_inv(i+nres)
1374 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1375 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1377 ! Calculate SC interaction energy.
1379 do iint=1,nint_gr(i)
1380 do j=istart(i,iint),iend(i,iint)
1381 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1382 call dyn_ssbond_ene(i,j,evdwij)
1384 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1385 'evdw',i,j,evdwij,' ss'
1386 ! if (energy_dec) write (iout,*) &
1387 ! 'evdw',i,j,evdwij,' ss'
1390 itypj=iabs(itype(j))
1391 if (itypj.eq.ntyp1) cycle
1392 ! if (j.ne.78) cycle
1393 ! dscj_inv=dsc_inv(itypj)
1394 dscj_inv=vbld_inv(j+nres)
1395 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,&
1396 ! 1.0d0/vbld(j+nres) !d
1397 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1398 sig0ij=sigma(itypi,itypj)
1399 chi1=chi(itypi,itypj)
1400 chi2=chi(itypj,itypi)
1407 alf12=0.5D0*(alf1+alf2)
1408 ! For diagnostics only!!!
1421 xj=dmod(xj,boxxsize)
1422 if (xj.lt.0) xj=xj+boxxsize
1423 yj=dmod(yj,boxysize)
1424 if (yj.lt.0) yj=yj+boxysize
1425 zj=dmod(zj,boxzsize)
1426 if (zj.lt.0) zj=zj+boxzsize
1427 ! print *,"tu",xi,yi,zi,xj,yj,zj
1428 ! print *,"tu2",j,j+nres,c(1,j),c(1,j+nres)
1429 ! this fragment set correct epsilon for lipid phase
1430 if ((zj.gt.bordlipbot) &
1431 .and.(zj.lt.bordliptop)) then
1432 !C the energy transfer exist
1433 if (zj.lt.buflipbot) then
1434 !C what fraction I am in
1436 ((zj-bordlipbot)/lipbufthick)
1437 !C lipbufthick is thickenes of lipid buffore
1438 sslipj=sscalelip(fracinbuf)
1439 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1440 elseif (zj.gt.bufliptop) then
1441 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1442 sslipj=sscalelip(fracinbuf)
1443 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1452 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1453 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1454 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1455 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1456 !------------------------------------------------
1457 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1465 xj=xj_safe+xshift*boxxsize
1466 yj=yj_safe+yshift*boxysize
1467 zj=zj_safe+zshift*boxzsize
1468 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1469 if(dist_temp.lt.dist_init) then
1479 if (subchap.eq.1) then
1488 dxj=dc_norm(1,nres+j)
1489 dyj=dc_norm(2,nres+j)
1490 dzj=dc_norm(3,nres+j)
1491 ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1492 ! write (iout,*) "j",j," dc_norm",& !d
1493 ! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1494 ! write(iout,*)"rrij ",rrij
1495 ! write(iout,*)"xj yj zj ", xj, yj, zj
1496 ! write(iout,*)"xi yi zi ", xi, yi, zi
1497 ! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
1498 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1500 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
1501 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
1502 ! print *,sss_ele_cut,sss_ele_grad,&
1503 ! 1.0d0/(rij),r_cut_ele,rlamb_ele
1504 if (sss_ele_cut.le.0.0) cycle
1505 ! Calculate angle-dependent terms of energy and contributions to their
1509 sig=sig0ij*dsqrt(sigsq)
1510 rij_shift=1.0D0/rij-sig+sig0ij
1511 ! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,&
1513 ! for diagnostics; uncomment
1514 ! rij_shift=1.2*sig0ij
1515 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1516 if (rij_shift.le.0.0D0) then
1518 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1519 !d & restyp(itypi),i,restyp(itypj),j,
1520 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1524 !---------------------------------------------------------------
1525 rij_shift=1.0D0/rij_shift
1526 fac=rij_shift**expon
1528 e1=fac*fac*aa!(itypi,itypj)
1529 e2=fac*bb!(itypi,itypj)
1530 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1531 eps2der=evdwij*eps3rt
1532 eps3der=evdwij*eps2rt
1533 ! write(iout,*)"aa, bb ",aa(:,:),bb(:,:)
1534 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d
1535 ! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d
1536 evdwij=evdwij*eps2rt*eps3rt
1537 evdw=evdw+evdwij*sss_ele_cut
1539 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1540 epsi=bb**2/aa!(itypi,itypj)
1541 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1542 restyp(itypi),i,restyp(itypj),j, &
1543 epsi,sigm,chi1,chi2,chip1,chip2, &
1544 eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
1545 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
1549 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')&
1550 'evdw',i,j,evdwij,xi,xj,rij !,"egb"
1551 !C print *,i,j,c(1,i),c(1,j),c(2,i),c(2,j),c(3,i),c(3,j)
1552 ! if (energy_dec) write (iout,*) &
1555 ! Calculate gradient components.
1556 e1=e1*eps1*eps2rt**2*eps3rt**2
1557 fac=-expon*(e1+evdwij)*rij_shift
1560 ! print *,'before fac',fac,rij,evdwij
1561 fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
1562 /sigma(itypi,itypj)*rij
1563 ! print *,'grad part scale',fac, &
1564 ! evdwij*sss_ele_grad/sss_ele_cut &
1565 ! /sigma(itypi,itypj)*rij
1567 ! Calculate the radial part of the gradient
1571 !C Calculate the radial part of the gradient
1572 gg_lipi(3)=eps1*(eps2rt*eps2rt)&
1573 *(eps3rt*eps3rt)*sss_ele_cut/2.0d0*(faclip*faclip*&
1574 (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))&
1575 +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1576 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1577 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1579 ! print *,'before sc_grad', gg(1),gg(2),gg(3)
1580 ! Calculate angular part of the gradient.
1586 ! write (iout,*) "Number of loop steps in EGB:",ind
1587 !ccc energy_dec=.false.
1590 !-----------------------------------------------------------------------------
1591 subroutine egbv(evdw)
1593 ! This subroutine calculates the interaction energy of nonbonded side chains
1594 ! assuming the Gay-Berne-Vorobjev potential of interaction.
1598 ! implicit real*8 (a-h,o-z)
1599 ! include 'DIMENSIONS'
1600 ! include 'COMMON.GEO'
1601 ! include 'COMMON.VAR'
1602 ! include 'COMMON.LOCAL'
1603 ! include 'COMMON.CHAIN'
1604 ! include 'COMMON.DERIV'
1605 ! include 'COMMON.NAMES'
1606 ! include 'COMMON.INTERACT'
1607 ! include 'COMMON.IOUNITS'
1608 ! include 'COMMON.CALC'
1610 !el integer :: icall
1611 !el common /srutu/ icall
1614 integer :: iint,itypi,itypi1,itypj
1615 real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
1616 real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
1618 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1621 ! if (icall.eq.0) lprn=.true.
1623 do i=iatsc_s,iatsc_e
1624 itypi=iabs(itype(i))
1625 if (itypi.eq.ntyp1) cycle
1626 itypi1=iabs(itype(i+1))
1630 dxi=dc_norm(1,nres+i)
1631 dyi=dc_norm(2,nres+i)
1632 dzi=dc_norm(3,nres+i)
1633 ! dsci_inv=dsc_inv(itypi)
1634 dsci_inv=vbld_inv(i+nres)
1636 ! Calculate SC interaction energy.
1638 do iint=1,nint_gr(i)
1639 do j=istart(i,iint),iend(i,iint)
1641 itypj=iabs(itype(j))
1642 if (itypj.eq.ntyp1) cycle
1643 ! dscj_inv=dsc_inv(itypj)
1644 dscj_inv=vbld_inv(j+nres)
1645 sig0ij=sigma(itypi,itypj)
1646 r0ij=r0(itypi,itypj)
1647 chi1=chi(itypi,itypj)
1648 chi2=chi(itypj,itypi)
1655 alf12=0.5D0*(alf1+alf2)
1656 ! For diagnostics only!!!
1669 dxj=dc_norm(1,nres+j)
1670 dyj=dc_norm(2,nres+j)
1671 dzj=dc_norm(3,nres+j)
1672 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1674 ! Calculate angle-dependent terms of energy and contributions to their
1678 sig=sig0ij*dsqrt(sigsq)
1679 rij_shift=1.0D0/rij-sig+r0ij
1680 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1681 if (rij_shift.le.0.0D0) then
1686 !---------------------------------------------------------------
1687 rij_shift=1.0D0/rij_shift
1688 fac=rij_shift**expon
1689 e1=fac*fac*aa_aq(itypi,itypj)
1690 e2=fac*bb_aq(itypi,itypj)
1691 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1692 eps2der=evdwij*eps3rt
1693 eps3der=evdwij*eps2rt
1694 fac_augm=rrij**expon
1695 e_augm=augm(itypi,itypj)*fac_augm
1696 evdwij=evdwij*eps2rt*eps3rt
1697 evdw=evdw+evdwij+e_augm
1699 sigm=dabs(aa_aq(itypi,itypj)/&
1700 bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1701 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1702 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1703 restyp(itypi),i,restyp(itypj),j,&
1704 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
1705 chi1,chi2,chip1,chip2,&
1706 eps1,eps2rt**2,eps3rt**2,&
1707 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
1710 ! Calculate gradient components.
1711 e1=e1*eps1*eps2rt**2*eps3rt**2
1712 fac=-expon*(e1+evdwij)*rij_shift
1714 fac=rij*fac-2*expon*rrij*e_augm
1715 ! Calculate the radial part of the gradient
1719 ! Calculate angular part of the gradient.
1725 !-----------------------------------------------------------------------------
1726 !el subroutine sc_angular in module geometry
1727 !-----------------------------------------------------------------------------
1728 subroutine e_softsphere(evdw)
1730 ! This subroutine calculates the interaction energy of nonbonded side chains
1731 ! assuming the LJ potential of interaction.
1733 ! implicit real*8 (a-h,o-z)
1734 ! include 'DIMENSIONS'
1735 real(kind=8),parameter :: accur=1.0d-10
1736 ! include 'COMMON.GEO'
1737 ! include 'COMMON.VAR'
1738 ! include 'COMMON.LOCAL'
1739 ! include 'COMMON.CHAIN'
1740 ! include 'COMMON.DERIV'
1741 ! include 'COMMON.INTERACT'
1742 ! include 'COMMON.TORSION'
1743 ! include 'COMMON.SBRIDGE'
1744 ! include 'COMMON.NAMES'
1745 ! include 'COMMON.IOUNITS'
1746 ! include 'COMMON.CONTACTS'
1747 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1748 !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1750 integer :: i,iint,j,itypi,itypi1,itypj,k
1751 real(kind=8) :: evdw,xj,yj,zj,xi,yi,zi,rij,r0ij,r0ijsq,evdwij
1755 do i=iatsc_s,iatsc_e
1756 itypi=iabs(itype(i))
1757 if (itypi.eq.ntyp1) cycle
1758 itypi1=iabs(itype(i+1))
1763 ! Calculate SC interaction energy.
1765 do iint=1,nint_gr(i)
1766 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1767 !d & 'iend=',iend(i,iint)
1768 do j=istart(i,iint),iend(i,iint)
1769 itypj=iabs(itype(j))
1770 if (itypj.eq.ntyp1) cycle
1774 rij=xj*xj+yj*yj+zj*zj
1775 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1776 r0ij=r0(itypi,itypj)
1778 ! print *,i,j,r0ij,dsqrt(rij)
1779 if (rij.lt.r0ijsq) then
1780 evdwij=0.25d0*(rij-r0ijsq)**2
1788 ! Calculate the components of the gradient in DC and X
1794 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1795 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1796 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1797 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1801 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1808 end subroutine e_softsphere
1809 !-----------------------------------------------------------------------------
1810 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1812 ! Soft-sphere potential of p-p interaction
1814 ! implicit real*8 (a-h,o-z)
1815 ! include 'DIMENSIONS'
1816 ! include 'COMMON.CONTROL'
1817 ! include 'COMMON.IOUNITS'
1818 ! include 'COMMON.GEO'
1819 ! include 'COMMON.VAR'
1820 ! include 'COMMON.LOCAL'
1821 ! include 'COMMON.CHAIN'
1822 ! include 'COMMON.DERIV'
1823 ! include 'COMMON.INTERACT'
1824 ! include 'COMMON.CONTACTS'
1825 ! include 'COMMON.TORSION'
1826 ! include 'COMMON.VECTORS'
1827 ! include 'COMMON.FFIELD'
1828 real(kind=8),dimension(3) :: ggg
1829 !d write(iout,*) 'In EELEC_soft_sphere'
1831 integer :: i,j,k,num_conti,iteli,itelj
1832 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
1833 real(kind=8) :: dxi,dyi,dzi,xmedi,ymedi,zmedi,r0ij,r0ijsq
1834 real(kind=8) :: dxj,dyj,dzj,xj,yj,zj,rij,evdw1ij,fac
1842 do i=iatel_s,iatel_e
1843 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1847 xmedi=c(1,i)+0.5d0*dxi
1848 ymedi=c(2,i)+0.5d0*dyi
1849 zmedi=c(3,i)+0.5d0*dzi
1851 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1852 do j=ielstart(i),ielend(i)
1853 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1857 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1858 r0ij=rpp(iteli,itelj)
1863 xj=c(1,j)+0.5D0*dxj-xmedi
1864 yj=c(2,j)+0.5D0*dyj-ymedi
1865 zj=c(3,j)+0.5D0*dzj-zmedi
1866 rij=xj*xj+yj*yj+zj*zj
1867 if (rij.lt.r0ijsq) then
1868 evdw1ij=0.25d0*(rij-r0ijsq)**2
1876 ! Calculate contributions to the Cartesian gradient.
1882 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1883 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1886 ! Loop over residues i+1 thru j-1.
1890 !grad gelc(l,k)=gelc(l,k)+ggg(l)
1895 !grad do i=nnt,nct-1
1897 !grad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1899 !grad do j=i+1,nct-1
1901 !grad gelc(k,i)=gelc(k,i)+gelc(k,j)
1906 end subroutine eelec_soft_sphere
1907 !-----------------------------------------------------------------------------
1908 subroutine vec_and_deriv
1909 ! implicit real*8 (a-h,o-z)
1910 ! include 'DIMENSIONS'
1914 ! include 'COMMON.IOUNITS'
1915 ! include 'COMMON.GEO'
1916 ! include 'COMMON.VAR'
1917 ! include 'COMMON.LOCAL'
1918 ! include 'COMMON.CHAIN'
1919 ! include 'COMMON.VECTORS'
1920 ! include 'COMMON.SETUP'
1921 ! include 'COMMON.TIME1'
1922 real(kind=8),dimension(3,3,2) :: uyder,uzder
1923 real(kind=8),dimension(2) :: vbld_inv_temp
1924 ! Compute the local reference systems. For reference system (i), the
1925 ! X-axis points from CA(i) to CA(i+1), the Y axis is in the
1926 ! CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1929 real(kind=8) :: facy,fac,costh
1932 do i=ivec_start,ivec_end
1936 if (i.eq.nres-1) then
1937 ! Case of the last full residue
1938 ! Compute the Z-axis
1939 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1940 costh=dcos(pi-theta(nres))
1941 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1945 ! Compute the derivatives of uz
1947 uzder(2,1,1)=-dc_norm(3,i-1)
1948 uzder(3,1,1)= dc_norm(2,i-1)
1949 uzder(1,2,1)= dc_norm(3,i-1)
1951 uzder(3,2,1)=-dc_norm(1,i-1)
1952 uzder(1,3,1)=-dc_norm(2,i-1)
1953 uzder(2,3,1)= dc_norm(1,i-1)
1956 uzder(2,1,2)= dc_norm(3,i)
1957 uzder(3,1,2)=-dc_norm(2,i)
1958 uzder(1,2,2)=-dc_norm(3,i)
1960 uzder(3,2,2)= dc_norm(1,i)
1961 uzder(1,3,2)= dc_norm(2,i)
1962 uzder(2,3,2)=-dc_norm(1,i)
1964 ! Compute the Y-axis
1967 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1969 ! Compute the derivatives of uy
1972 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) &
1973 -dc_norm(k,i)*dc_norm(j,i-1)
1974 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1976 uyder(j,j,1)=uyder(j,j,1)-costh
1977 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1982 uygrad(l,k,j,i)=uyder(l,k,j)
1983 uzgrad(l,k,j,i)=uzder(l,k,j)
1987 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1988 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1989 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1990 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1993 ! Compute the Z-axis
1994 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1995 costh=dcos(pi-theta(i+2))
1996 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2000 ! Compute the derivatives of uz
2002 uzder(2,1,1)=-dc_norm(3,i+1)
2003 uzder(3,1,1)= dc_norm(2,i+1)
2004 uzder(1,2,1)= dc_norm(3,i+1)
2006 uzder(3,2,1)=-dc_norm(1,i+1)
2007 uzder(1,3,1)=-dc_norm(2,i+1)
2008 uzder(2,3,1)= dc_norm(1,i+1)
2011 uzder(2,1,2)= dc_norm(3,i)
2012 uzder(3,1,2)=-dc_norm(2,i)
2013 uzder(1,2,2)=-dc_norm(3,i)
2015 uzder(3,2,2)= dc_norm(1,i)
2016 uzder(1,3,2)= dc_norm(2,i)
2017 uzder(2,3,2)=-dc_norm(1,i)
2019 ! Compute the Y-axis
2022 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2024 ! Compute the derivatives of uy
2027 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) &
2028 -dc_norm(k,i)*dc_norm(j,i+1)
2029 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2031 uyder(j,j,1)=uyder(j,j,1)-costh
2032 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2037 uygrad(l,k,j,i)=uyder(l,k,j)
2038 uzgrad(l,k,j,i)=uzder(l,k,j)
2042 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2043 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2044 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2045 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2049 vbld_inv_temp(1)=vbld_inv(i+1)
2050 if (i.lt.nres-1) then
2051 vbld_inv_temp(2)=vbld_inv(i+2)
2053 vbld_inv_temp(2)=vbld_inv(i)
2058 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2059 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2064 #if defined(PARVEC) && defined(MPI)
2065 if (nfgtasks1.gt.1) then
2067 ! print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2068 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2069 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2070 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),&
2071 MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2073 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),&
2074 MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2076 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),&
2077 ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),&
2078 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2079 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),&
2080 ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),&
2081 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2082 time_gather=time_gather+MPI_Wtime()-time00
2084 ! if (fg_rank.eq.0) then
2085 ! write (iout,*) "Arrays UY and UZ"
2087 ! write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2093 end subroutine vec_and_deriv
2094 !-----------------------------------------------------------------------------
2095 subroutine check_vecgrad
2096 ! implicit real*8 (a-h,o-z)
2097 ! include 'DIMENSIONS'
2098 ! include 'COMMON.IOUNITS'
2099 ! include 'COMMON.GEO'
2100 ! include 'COMMON.VAR'
2101 ! include 'COMMON.LOCAL'
2102 ! include 'COMMON.CHAIN'
2103 ! include 'COMMON.VECTORS'
2104 real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
2105 real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
2106 real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
2107 real(kind=8),dimension(3) :: erij
2108 real(kind=8) :: delta=1.0d-7
2114 !rc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2115 !rc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2116 !rc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2117 !d write(iout,'(2i5,2(3f10.5,5x))') i,1,
2118 !d & (dc_norm(if90,i),if90=1,3)
2119 !d write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2120 !d write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2121 !d write(iout,'(a)')
2127 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2128 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2141 !d write (iout,*) 'i=',i
2143 erij(k)=dc_norm(k,i)
2147 dc_norm(k,i)=erij(k)
2149 dc_norm(j,i)=dc_norm(j,i)+delta
2150 ! fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2152 ! dc_norm(k,i)=dc_norm(k,i)/fac
2154 ! write (iout,*) (dc_norm(k,i),k=1,3)
2155 ! write (iout,*) (erij(k),k=1,3)
2158 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2159 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2160 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2161 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2163 ! write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2164 ! & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2165 ! & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2168 dc_norm(k,i)=erij(k)
2171 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2172 !d & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2173 !d & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2174 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2175 !d & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2176 !d & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2177 !d write (iout,'(a)')
2181 end subroutine check_vecgrad
2182 !-----------------------------------------------------------------------------
2183 subroutine set_matrices
2184 ! implicit real*8 (a-h,o-z)
2185 ! include 'DIMENSIONS'
2188 ! include "COMMON.SETUP"
2190 integer :: status(MPI_STATUS_SIZE)
2192 ! include 'COMMON.IOUNITS'
2193 ! include 'COMMON.GEO'
2194 ! include 'COMMON.VAR'
2195 ! include 'COMMON.LOCAL'
2196 ! include 'COMMON.CHAIN'
2197 ! include 'COMMON.DERIV'
2198 ! include 'COMMON.INTERACT'
2199 ! include 'COMMON.CONTACTS'
2200 ! include 'COMMON.TORSION'
2201 ! include 'COMMON.VECTORS'
2202 ! include 'COMMON.FFIELD'
2203 real(kind=8) :: auxvec(2),auxmat(2,2)
2204 integer :: i,iti1,iti,k,l
2205 real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2
2206 ! print *,"in set matrices"
2208 ! Compute the virtual-bond-torsional-angle dependent quantities needed
2209 ! to calculate the el-loc multibody terms of various order.
2213 do i=ivec_start+2,ivec_end+2
2218 if (i .lt. nres+1) then
2255 if (i .gt. 3 .and. i .lt. nres+1) then
2256 obrot_der(1,i-2)=-sin1
2257 obrot_der(2,i-2)= cos1
2258 Ugder(1,1,i-2)= sin1
2259 Ugder(1,2,i-2)=-cos1
2260 Ugder(2,1,i-2)=-cos1
2261 Ugder(2,2,i-2)=-sin1
2264 obrot2_der(1,i-2)=-dwasin2
2265 obrot2_der(2,i-2)= dwacos2
2266 Ug2der(1,1,i-2)= dwasin2
2267 Ug2der(1,2,i-2)=-dwacos2
2268 Ug2der(2,1,i-2)=-dwacos2
2269 Ug2der(2,2,i-2)=-dwasin2
2271 obrot_der(1,i-2)=0.0d0
2272 obrot_der(2,i-2)=0.0d0
2273 Ugder(1,1,i-2)=0.0d0
2274 Ugder(1,2,i-2)=0.0d0
2275 Ugder(2,1,i-2)=0.0d0
2276 Ugder(2,2,i-2)=0.0d0
2277 obrot2_der(1,i-2)=0.0d0
2278 obrot2_der(2,i-2)=0.0d0
2279 Ug2der(1,1,i-2)=0.0d0
2280 Ug2der(1,2,i-2)=0.0d0
2281 Ug2der(2,1,i-2)=0.0d0
2282 Ug2der(2,2,i-2)=0.0d0
2284 ! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2285 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2286 iti = itortyp(itype(i-2))
2290 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2291 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2292 iti1 = itortyp(itype(i-1))
2296 ! print *,iti,i,"iti",iti1,itype(i-1),itype(i-2)
2297 !d write (iout,*) '*******i',i,' iti1',iti
2298 !d write (iout,*) 'b1',b1(:,iti)
2299 !d write (iout,*) 'b2',b2(:,iti)
2300 !d write (iout,*) 'Ug',Ug(:,:,i-2)
2301 ! if (i .gt. iatel_s+2) then
2302 if (i .gt. nnt+2) then
2303 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2304 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2305 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2307 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2308 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2309 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2310 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2311 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2322 DtUg2(l,k,i-2)=0.0d0
2326 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2327 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2329 muder(k,i-2)=Ub2der(k,i-2)
2331 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2332 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2333 if (itype(i-1).le.ntyp) then
2334 iti1 = itortyp(itype(i-1))
2342 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2344 ! if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
2345 ! if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,iti1)
2346 ! if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
2347 !d write (iout,*) 'mu1',mu1(:,i-2)
2348 !d write (iout,*) 'mu2',mu2(:,i-2)
2349 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2351 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2352 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2353 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2354 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2355 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2356 ! Vectors and matrices dependent on a single virtual-bond dihedral.
2357 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2358 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2359 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2360 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2361 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2362 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2363 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2364 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2365 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2368 ! Matrices dependent on two consecutive virtual-bond dihedrals.
2369 ! The order of matrices is from left to right.
2370 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2372 ! do i=max0(ivec_start,2),ivec_end
2374 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2375 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2376 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2377 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2378 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2379 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2380 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2381 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2384 #if defined(MPI) && defined(PARMAT)
2386 ! if (fg_rank.eq.0) then
2387 write (iout,*) "Arrays UG and UGDER before GATHER"
2389 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2390 ((ug(l,k,i),l=1,2),k=1,2),&
2391 ((ugder(l,k,i),l=1,2),k=1,2)
2393 write (iout,*) "Arrays UG2 and UG2DER"
2395 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2396 ((ug2(l,k,i),l=1,2),k=1,2),&
2397 ((ug2der(l,k,i),l=1,2),k=1,2)
2399 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2401 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2402 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2403 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2405 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2407 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2408 costab(i),sintab(i),costab2(i),sintab2(i)
2410 write (iout,*) "Array MUDER"
2412 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2416 if (nfgtasks.gt.1) then
2418 ! write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2419 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2420 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2422 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),&
2423 MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2425 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),&
2426 MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2428 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),&
2429 MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2431 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),&
2432 MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2434 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),&
2435 MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2437 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),&
2438 MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2440 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),&
2441 MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),&
2442 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2443 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),&
2444 MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),&
2445 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2446 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),&
2447 MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),&
2448 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2449 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),&
2450 MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),&
2451 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2452 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2454 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),&
2455 MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2457 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),&
2458 MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2460 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),&
2461 MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2463 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),&
2464 MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2466 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),&
2467 MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2469 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),&
2470 ivec_count(fg_rank1),&
2471 MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2473 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),&
2474 MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2476 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),&
2477 MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2479 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),&
2480 MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2482 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),&
2483 MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2485 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),&
2486 MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2488 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),&
2489 MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2491 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),&
2492 MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2494 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),&
2495 ivec_count(fg_rank1),&
2496 MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2498 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),&
2499 MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2501 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),&
2502 MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2504 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),&
2505 MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2507 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),&
2508 MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2510 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),&
2511 ivec_count(fg_rank1),&
2512 MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2514 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),&
2515 ivec_count(fg_rank1),&
2516 MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2518 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),&
2519 ivec_count(fg_rank1),&
2520 MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2521 MPI_MAT2,FG_COMM1,IERR)
2522 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),&
2523 ivec_count(fg_rank1),&
2524 MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2525 MPI_MAT2,FG_COMM1,IERR)
2528 ! Passes matrix info through the ring
2531 if (irecv.lt.0) irecv=nfgtasks1-1
2534 if (inext.ge.nfgtasks1) inext=0
2536 ! write (iout,*) "isend",isend," irecv",irecv
2538 lensend=lentyp(isend)
2539 lenrecv=lentyp(irecv)
2540 ! write (iout,*) "lensend",lensend," lenrecv",lenrecv
2541 ! call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2542 ! & MPI_ROTAT1(lensend),inext,2200+isend,
2543 ! & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2544 ! & iprev,2200+irecv,FG_COMM,status,IERR)
2545 ! write (iout,*) "Gather ROTAT1"
2547 ! call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2548 ! & MPI_ROTAT2(lensend),inext,3300+isend,
2549 ! & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2550 ! & iprev,3300+irecv,FG_COMM,status,IERR)
2551 ! write (iout,*) "Gather ROTAT2"
2553 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,&
2554 MPI_ROTAT_OLD(lensend),inext,4400+isend,&
2555 costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),&
2556 iprev,4400+irecv,FG_COMM,status,IERR)
2557 ! write (iout,*) "Gather ROTAT_OLD"
2559 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,&
2560 MPI_PRECOMP11(lensend),inext,5500+isend,&
2561 mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),&
2562 iprev,5500+irecv,FG_COMM,status,IERR)
2563 ! write (iout,*) "Gather PRECOMP11"
2565 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,&
2566 MPI_PRECOMP12(lensend),inext,6600+isend,&
2567 Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),&
2568 iprev,6600+irecv,FG_COMM,status,IERR)
2569 ! write (iout,*) "Gather PRECOMP12"
2571 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2573 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,&
2574 MPI_ROTAT2(lensend),inext,7700+isend,&
2575 ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),&
2576 iprev,7700+irecv,FG_COMM,status,IERR)
2577 ! write (iout,*) "Gather PRECOMP21"
2579 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,&
2580 MPI_PRECOMP22(lensend),inext,8800+isend,&
2581 EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),&
2582 iprev,8800+irecv,FG_COMM,status,IERR)
2583 ! write (iout,*) "Gather PRECOMP22"
2585 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,&
2586 MPI_PRECOMP23(lensend),inext,9900+isend,&
2587 Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,&
2588 MPI_PRECOMP23(lenrecv),&
2589 iprev,9900+irecv,FG_COMM,status,IERR)
2590 ! write (iout,*) "Gather PRECOMP23"
2595 if (irecv.lt.0) irecv=nfgtasks1-1
2598 time_gather=time_gather+MPI_Wtime()-time00
2601 ! if (fg_rank.eq.0) then
2602 write (iout,*) "Arrays UG and UGDER"
2604 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2605 ((ug(l,k,i),l=1,2),k=1,2),&
2606 ((ugder(l,k,i),l=1,2),k=1,2)
2608 write (iout,*) "Arrays UG2 and UG2DER"
2610 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2611 ((ug2(l,k,i),l=1,2),k=1,2),&
2612 ((ug2der(l,k,i),l=1,2),k=1,2)
2614 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2616 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2617 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2618 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2620 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2622 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2623 costab(i),sintab(i),costab2(i),sintab2(i)
2625 write (iout,*) "Array MUDER"
2627 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2633 !d iti = itortyp(itype(i))
2636 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2637 !d & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2641 end subroutine set_matrices
2642 !-----------------------------------------------------------------------------
2643 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2645 ! This subroutine calculates the average interaction energy and its gradient
2646 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
2647 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2648 ! The potential depends both on the distance of peptide-group centers and on
2649 ! the orientation of the CA-CA virtual bonds.
2652 ! implicit real*8 (a-h,o-z)
2656 ! include 'DIMENSIONS'
2657 ! include 'COMMON.CONTROL'
2658 ! include 'COMMON.SETUP'
2659 ! include 'COMMON.IOUNITS'
2660 ! include 'COMMON.GEO'
2661 ! include 'COMMON.VAR'
2662 ! include 'COMMON.LOCAL'
2663 ! include 'COMMON.CHAIN'
2664 ! include 'COMMON.DERIV'
2665 ! include 'COMMON.INTERACT'
2666 ! include 'COMMON.CONTACTS'
2667 ! include 'COMMON.TORSION'
2668 ! include 'COMMON.VECTORS'
2669 ! include 'COMMON.FFIELD'
2670 ! include 'COMMON.TIME1'
2671 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
2672 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2673 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2674 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2675 real(kind=8),dimension(4) :: muij
2676 !el integer :: num_conti,j1,j2
2677 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2678 !el dz_normi,xmedi,ymedi,zmedi
2680 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2681 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
2684 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2686 real(kind=8) :: scal_el=1.0d0
2688 real(kind=8) :: scal_el=0.5d0
2691 ! 13-go grudnia roku pamietnego...
2692 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
2694 0.0d0,0.0d0,1.0d0/),shape(unmat))
2697 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2698 real(kind=8) :: fac,t_eelecij,fracinbuf
2701 !d write(iout,*) 'In EELEC'
2702 ! print *,"IN EELEC"
2704 !d write(iout,*) 'Type',i
2705 !d write(iout,*) 'B1',B1(:,i)
2706 !d write(iout,*) 'B2',B2(:,i)
2707 !d write(iout,*) 'CC',CC(:,:,i)
2708 !d write(iout,*) 'DD',DD(:,:,i)
2709 !d write(iout,*) 'EE',EE(:,:,i)
2711 !d call check_vecgrad
2726 if (icheckgrad.eq.1) then
2729 ! dc_norm(1,i)=0.0d0
2730 ! dc_norm(2,i)=0.0d0
2731 ! dc_norm(3,i)=0.0d0
2734 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2736 dc_norm(k,i)=dc(k,i)*fac
2738 ! write (iout,*) 'i',i,' fac',fac
2741 print *,wel_loc,"wel_loc",wcorr4,wcorr5,wcorr6,wturn3,wturn4, &
2743 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
2744 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
2745 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2746 ! call vec_and_deriv
2750 ! print *, "before set matrices"
2752 ! print *, "after set matrices"
2755 time_mat=time_mat+MPI_Wtime()-time01
2758 ! print *, "after set matrices"
2760 !d write (iout,*) 'i=',i
2762 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2765 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2766 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2779 !d print '(a)','Enter EELEC'
2780 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2781 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
2782 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
2784 gel_loc_loc(i)=0.0d0
2789 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2791 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
2795 ! print *,"before iturn3 loop"
2796 do i=iturn3_start,iturn3_end
2797 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
2798 .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2802 dx_normi=dc_norm(1,i)
2803 dy_normi=dc_norm(2,i)
2804 dz_normi=dc_norm(3,i)
2805 xmedi=c(1,i)+0.5d0*dxi
2806 ymedi=c(2,i)+0.5d0*dyi
2807 zmedi=c(3,i)+0.5d0*dzi
2808 xmedi=dmod(xmedi,boxxsize)
2809 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2810 ymedi=dmod(ymedi,boxysize)
2811 if (ymedi.lt.0) ymedi=ymedi+boxysize
2812 zmedi=dmod(zmedi,boxzsize)
2813 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2815 if ((zmedi.gt.bordlipbot) &
2816 .and.(zmedi.lt.bordliptop)) then
2817 !C the energy transfer exist
2818 if (zmedi.lt.buflipbot) then
2819 !C what fraction I am in
2821 ((zmedi-bordlipbot)/lipbufthick)
2822 !C lipbufthick is thickenes of lipid buffore
2823 sslipi=sscalelip(fracinbuf)
2824 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
2825 elseif (zmedi.gt.bufliptop) then
2826 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
2827 sslipi=sscalelip(fracinbuf)
2828 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
2837 ! print *,i,sslipi,ssgradlipi
2838 call eelecij(i,i+2,ees,evdw1,eel_loc)
2839 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2840 num_cont_hb(i)=num_conti
2842 do i=iturn4_start,iturn4_end
2843 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
2844 .or. itype(i+3).eq.ntyp1 &
2845 .or. itype(i+4).eq.ntyp1) cycle
2849 dx_normi=dc_norm(1,i)
2850 dy_normi=dc_norm(2,i)
2851 dz_normi=dc_norm(3,i)
2852 xmedi=c(1,i)+0.5d0*dxi
2853 ymedi=c(2,i)+0.5d0*dyi
2854 zmedi=c(3,i)+0.5d0*dzi
2855 xmedi=dmod(xmedi,boxxsize)
2856 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2857 ymedi=dmod(ymedi,boxysize)
2858 if (ymedi.lt.0) ymedi=ymedi+boxysize
2859 zmedi=dmod(zmedi,boxzsize)
2860 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2861 if ((zmedi.gt.bordlipbot) &
2862 .and.(zmedi.lt.bordliptop)) then
2863 !C the energy transfer exist
2864 if (zmedi.lt.buflipbot) then
2865 !C what fraction I am in
2867 ((zmedi-bordlipbot)/lipbufthick)
2868 !C lipbufthick is thickenes of lipid buffore
2869 sslipi=sscalelip(fracinbuf)
2870 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
2871 elseif (zmedi.gt.bufliptop) then
2872 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
2873 sslipi=sscalelip(fracinbuf)
2874 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
2884 num_conti=num_cont_hb(i)
2885 call eelecij(i,i+3,ees,evdw1,eel_loc)
2886 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
2887 call eturn4(i,eello_turn4)
2888 num_cont_hb(i)=num_conti
2891 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2893 do i=iatel_s,iatel_e
2894 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2898 dx_normi=dc_norm(1,i)
2899 dy_normi=dc_norm(2,i)
2900 dz_normi=dc_norm(3,i)
2901 xmedi=c(1,i)+0.5d0*dxi
2902 ymedi=c(2,i)+0.5d0*dyi
2903 zmedi=c(3,i)+0.5d0*dzi
2904 xmedi=dmod(xmedi,boxxsize)
2905 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2906 ymedi=dmod(ymedi,boxysize)
2907 if (ymedi.lt.0) ymedi=ymedi+boxysize
2908 zmedi=dmod(zmedi,boxzsize)
2909 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2910 if ((zmedi.gt.bordlipbot) &
2911 .and.(zmedi.lt.bordliptop)) then
2912 !C the energy transfer exist
2913 if (zmedi.lt.buflipbot) then
2914 !C what fraction I am in
2916 ((zmedi-bordlipbot)/lipbufthick)
2917 !C lipbufthick is thickenes of lipid buffore
2918 sslipi=sscalelip(fracinbuf)
2919 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
2920 elseif (zmedi.gt.bufliptop) then
2921 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
2922 sslipi=sscalelip(fracinbuf)
2923 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
2933 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2934 num_conti=num_cont_hb(i)
2935 do j=ielstart(i),ielend(i)
2936 ! write (iout,*) i,j,itype(i),itype(j)
2937 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2938 call eelecij(i,j,ees,evdw1,eel_loc)
2940 num_cont_hb(i)=num_conti
2942 ! write (iout,*) "Number of loop steps in EELEC:",ind
2944 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
2945 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2947 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2948 !cc eel_loc=eel_loc+eello_turn3
2949 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
2951 end subroutine eelec
2952 !-----------------------------------------------------------------------------
2953 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2956 ! implicit real*8 (a-h,o-z)
2957 ! include 'DIMENSIONS'
2961 ! include 'COMMON.CONTROL'
2962 ! include 'COMMON.IOUNITS'
2963 ! include 'COMMON.GEO'
2964 ! include 'COMMON.VAR'
2965 ! include 'COMMON.LOCAL'
2966 ! include 'COMMON.CHAIN'
2967 ! include 'COMMON.DERIV'
2968 ! include 'COMMON.INTERACT'
2969 ! include 'COMMON.CONTACTS'
2970 ! include 'COMMON.TORSION'
2971 ! include 'COMMON.VECTORS'
2972 ! include 'COMMON.FFIELD'
2973 ! include 'COMMON.TIME1'
2974 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
2975 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2976 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2977 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2978 real(kind=8),dimension(4) :: muij
2979 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
2980 dist_temp, dist_init,rlocshield,fracinbuf
2981 integer xshift,yshift,zshift,ilist,iresshield
2982 !el integer :: num_conti,j1,j2
2983 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2984 !el dz_normi,xmedi,ymedi,zmedi
2986 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2987 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
2990 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2992 real(kind=8) :: scal_el=1.0d0
2994 real(kind=8) :: scal_el=0.5d0
2997 ! 13-go grudnia roku pamietnego...
2998 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3000 0.0d0,0.0d0,1.0d0/),shape(unmat))
3001 ! integer :: maxconts=nres/4
3003 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
3004 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
3005 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
3006 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
3007 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
3008 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
3009 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
3010 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
3011 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
3012 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
3013 ecosgp,ecosam,ecosbm,ecosgm,ghalf
3015 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
3016 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
3018 ! time00=MPI_Wtime()
3019 !d write (iout,*) "eelecij",i,j
3023 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3024 aaa=app(iteli,itelj)
3025 bbb=bpp(iteli,itelj)
3026 ael6i=ael6(iteli,itelj)
3027 ael3i=ael3(iteli,itelj)
3031 dx_normj=dc_norm(1,j)
3032 dy_normj=dc_norm(2,j)
3033 dz_normj=dc_norm(3,j)
3034 ! xj=c(1,j)+0.5D0*dxj-xmedi
3035 ! yj=c(2,j)+0.5D0*dyj-ymedi
3036 ! zj=c(3,j)+0.5D0*dzj-zmedi
3041 if (xj.lt.0) xj=xj+boxxsize
3043 if (yj.lt.0) yj=yj+boxysize
3045 if (zj.lt.0) zj=zj+boxzsize
3046 if ((zj.gt.bordlipbot) &
3047 .and.(zj.lt.bordliptop)) then
3048 !C the energy transfer exist
3049 if (zj.lt.buflipbot) then
3050 !C what fraction I am in
3052 ((zj-bordlipbot)/lipbufthick)
3053 !C lipbufthick is thickenes of lipid buffore
3054 sslipj=sscalelip(fracinbuf)
3055 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3056 elseif (zj.gt.bufliptop) then
3057 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3058 sslipj=sscalelip(fracinbuf)
3059 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3070 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3077 xj=xj_safe+xshift*boxxsize
3078 yj=yj_safe+yshift*boxysize
3079 zj=zj_safe+zshift*boxzsize
3080 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3081 if(dist_temp.lt.dist_init) then
3091 if (isubchap.eq.1) then
3102 rij=xj*xj+yj*yj+zj*zj
3105 !C print *,xmedi,ymedi,zmedi,xj,yj,zj,boxxsize,rij
3106 sss_ele_cut=sscale_ele(rij)
3107 sss_ele_grad=sscagrad_ele(rij)
3109 ! sss_ele_grad=0.0d0
3110 ! print *,sss_ele_cut,sss_ele_grad,&
3111 ! (rij),r_cut_ele,rlamb_ele
3112 ! if (sss_ele_cut.le.0.0) go to 128
3117 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3118 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3119 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3120 fac=cosa-3.0D0*cosb*cosg
3122 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3123 if (j.eq.i+2) ev1=scal_el*ev1
3128 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3131 if (shield_mode.gt.0) then
3132 !C fac_shield(i)=0.4
3133 !C fac_shield(j)=0.6
3134 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3135 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3137 ees=ees+eesij*sss_ele_cut
3138 !C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
3139 !C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3145 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)*sss_ele_cut
3146 !C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
3149 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
3150 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3151 ! ees=ees+eesij*sss_ele_cut
3152 evdw1=evdw1+evdwij*sss_ele_cut &
3153 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3154 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3155 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3156 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3157 !d & xmedi,ymedi,zmedi,xj,yj,zj
3159 if (energy_dec) then
3160 ! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
3161 ! 'evdw1',i,j,evdwij,&
3162 ! iteli,itelj,aaa,evdw1
3163 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3164 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3167 ! Calculate contributions to the Cartesian gradient.
3170 facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut &
3171 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3172 facel=-3*rrmij*(el1+eesij)*sss_ele_cut &
3173 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3179 ! Radial derivatives. First process both termini of the fragment (i,j)
3181 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj* &
3182 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3183 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj* &
3184 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3185 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj* &
3186 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3188 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3189 (shield_mode.gt.0)) then
3191 do ilist=1,ishield_list(i)
3192 iresshield=shield_list(ilist,i)
3194 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)&
3196 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3198 +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 &
3200 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3203 do ilist=1,ishield_list(j)
3204 iresshield=shield_list(ilist,j)
3206 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) &
3208 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3210 +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 &
3212 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3216 gshieldc(k,i)=gshieldc(k,i)+ &
3217 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3220 gshieldc(k,j)=gshieldc(k,j)+ &
3221 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3224 gshieldc(k,i-1)=gshieldc(k,i-1)+ &
3225 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3228 gshieldc(k,j-1)=gshieldc(k,j-1)+ &
3229 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3237 ! ghalf=0.5D0*ggg(k)
3238 ! gelc(k,i)=gelc(k,i)+ghalf
3239 ! gelc(k,j)=gelc(k,j)+ghalf
3241 ! 9/28/08 AL Gradient compotents will be summed only at the end
3243 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3244 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3246 gelc_long(3,j)=gelc_long(3,j)+ &
3247 ssgradlipj*eesij/2.0d0*lipscale**2&
3250 gelc_long(3,i)=gelc_long(3,i)+ &
3251 ssgradlipi*eesij/2.0d0*lipscale**2&
3256 ! Loop over residues i+1 thru j-1.
3260 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3263 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
3264 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3265 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
3266 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3267 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
3268 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3271 ! ghalf=0.5D0*ggg(k)
3272 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3273 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3275 ! 9/28/08 AL Gradient compotents will be summed only at the end
3277 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3278 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3281 !C Lipidic part for scaling weight
3282 gvdwpp(3,j)=gvdwpp(3,j)+ &
3283 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3284 gvdwpp(3,i)=gvdwpp(3,i)+ &
3285 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3286 !! Loop over residues i+1 thru j-1.
3290 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3294 facvdw=(ev1+evdwij)*sss_ele_cut &
3295 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3297 facel=(el1+eesij)*sss_ele_cut
3299 fac=-3*rrmij*(facvdw+facvdw+facel)
3304 ! Radial derivatives. First process both termini of the fragment (i,j)
3306 ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj
3307 ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj
3308 ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj
3310 ! ghalf=0.5D0*ggg(k)
3311 ! gelc(k,i)=gelc(k,i)+ghalf
3312 ! gelc(k,j)=gelc(k,j)+ghalf
3314 ! 9/28/08 AL Gradient compotents will be summed only at the end
3316 gelc_long(k,j)=gelc(k,j)+ggg(k)
3317 gelc_long(k,i)=gelc(k,i)-ggg(k)
3320 ! Loop over residues i+1 thru j-1.
3324 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3327 ! 9/28/08 AL Gradient compotents will be summed only at the end
3329 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3331 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3333 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3336 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3337 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3339 gvdwpp(3,j)=gvdwpp(3,j)+ &
3340 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3341 gvdwpp(3,i)=gvdwpp(3,i)+ &
3342 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3348 ecosa=2.0D0*fac3*fac1+fac4
3351 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3352 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3354 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3355 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3357 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3358 !d & (dcosg(k),k=1,3)
3360 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut &
3361 *fac_shield(i)**2*fac_shield(j)**2 &
3362 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3366 ! ghalf=0.5D0*ggg(k)
3367 ! gelc(k,i)=gelc(k,i)+ghalf
3368 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3369 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3370 ! gelc(k,j)=gelc(k,j)+ghalf
3371 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3372 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3376 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3380 gelc(k,i)=gelc(k,i) &
3381 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3382 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
3384 *fac_shield(i)**2*fac_shield(j)**2 &
3385 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3387 gelc(k,j)=gelc(k,j) &
3388 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3389 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
3391 *fac_shield(i)**2*fac_shield(j)**2 &
3392 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3394 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3395 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3398 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3399 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
3400 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3402 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3403 ! energy of a peptide unit is assumed in the form of a second-order
3404 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3405 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3406 ! are computed for EVERY pair of non-contiguous peptide groups.
3408 if (j.lt.nres-1) then
3419 muij(kkk)=mu(k,i)*mu(l,j)
3422 !d write (iout,*) 'EELEC: i',i,' j',j
3423 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
3424 !d write(iout,*) 'muij',muij
3425 ury=scalar(uy(1,i),erij)
3426 urz=scalar(uz(1,i),erij)
3427 vry=scalar(uy(1,j),erij)
3428 vrz=scalar(uz(1,j),erij)
3429 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3430 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3431 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3432 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3433 fac=dsqrt(-ael6i)*r3ij
3438 !d write (iout,'(4i5,4f10.5)')
3439 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3440 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3441 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3442 !d & uy(:,j),uz(:,j)
3443 !d write (iout,'(4f10.5)')
3444 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3445 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3446 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
3447 !d write (iout,'(9f10.5/)')
3448 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3449 ! Derivatives of the elements of A in virtual-bond vectors
3450 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3452 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3453 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3454 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3455 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3456 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3457 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3458 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3459 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3460 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3461 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3462 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3463 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3465 ! Compute radial contributions to the gradient
3483 ! Add the contributions coming from er
3486 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3487 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3488 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3489 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3492 ! Derivatives in DC(i)
3493 !grad ghalf1=0.5d0*agg(k,1)
3494 !grad ghalf2=0.5d0*agg(k,2)
3495 !grad ghalf3=0.5d0*agg(k,3)
3496 !grad ghalf4=0.5d0*agg(k,4)
3497 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
3498 -3.0d0*uryg(k,2)*vry)!+ghalf1
3499 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
3500 -3.0d0*uryg(k,2)*vrz)!+ghalf2
3501 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
3502 -3.0d0*urzg(k,2)*vry)!+ghalf3
3503 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
3504 -3.0d0*urzg(k,2)*vrz)!+ghalf4
3505 ! Derivatives in DC(i+1)
3506 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
3507 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3508 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
3509 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3510 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
3511 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3512 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
3513 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3514 ! Derivatives in DC(j)
3515 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
3516 -3.0d0*vryg(k,2)*ury)!+ghalf1
3517 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
3518 -3.0d0*vrzg(k,2)*ury)!+ghalf2
3519 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
3520 -3.0d0*vryg(k,2)*urz)!+ghalf3
3521 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
3522 -3.0d0*vrzg(k,2)*urz)!+ghalf4
3523 ! Derivatives in DC(j+1) or DC(nres-1)
3524 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
3525 -3.0d0*vryg(k,3)*ury)
3526 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
3527 -3.0d0*vrzg(k,3)*ury)
3528 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
3529 -3.0d0*vryg(k,3)*urz)
3530 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
3531 -3.0d0*vrzg(k,3)*urz)
3532 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
3534 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3547 aggi(k,l)=-aggi(k,l)
3548 aggi1(k,l)=-aggi1(k,l)
3549 aggj(k,l)=-aggj(k,l)
3550 aggj1(k,l)=-aggj1(k,l)
3553 if (j.lt.nres-1) then
3559 aggi(k,l)=-aggi(k,l)
3560 aggi1(k,l)=-aggi1(k,l)
3561 aggj(k,l)=-aggj(k,l)
3562 aggj1(k,l)=-aggj1(k,l)
3573 aggi(k,l)=-aggi(k,l)
3574 aggi1(k,l)=-aggi1(k,l)
3575 aggj(k,l)=-aggj(k,l)
3576 aggj1(k,l)=-aggj1(k,l)
3581 IF (wel_loc.gt.0.0d0) THEN
3582 ! Contribution to the local-electrostatic energy coming from the i-j pair
3583 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
3585 if (shield_mode.eq.0) then
3589 eel_loc_ij=eel_loc_ij &
3590 *fac_shield(i)*fac_shield(j) &
3591 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3592 !C Now derivative over eel_loc
3593 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3594 (shield_mode.gt.0)) then
3597 do ilist=1,ishield_list(i)
3598 iresshield=shield_list(ilist,i)
3600 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij &
3603 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3605 +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) &
3608 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3612 do ilist=1,ishield_list(j)
3613 iresshield=shield_list(ilist,j)
3615 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij &
3618 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3620 +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) &
3623 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3630 gshieldc_ll(k,i)=gshieldc_ll(k,i)+ &
3631 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3633 gshieldc_ll(k,j)=gshieldc_ll(k,j)+ &
3634 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3636 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ &
3637 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3639 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ &
3640 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3647 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3649 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3650 'eelloc',i,j,eel_loc_ij
3651 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
3652 ! if (energy_dec) write (iout,*) "muij",muij
3653 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3655 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
3656 ! Partial derivatives in virtual-bond dihedral angles gamma
3658 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
3659 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
3660 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
3662 *fac_shield(i)*fac_shield(j) &
3663 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3665 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
3666 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
3667 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
3669 *fac_shield(i)*fac_shield(j) &
3670 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3671 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3673 ! ggg(1)=(agg(1,1)*muij(1)+ &
3674 ! agg(1,2)*muij(2)+agg(1,3)*muij(3)+agg(1,4)*muij(4)) &
3676 ! +eel_loc_ij*sss_ele_grad*rmij*xj
3677 ! ggg(2)=(agg(2,1)*muij(1)+ &
3678 ! agg(2,2)*muij(2)+agg(2,3)*muij(3)+agg(2,4)*muij(4)) &
3680 ! +eel_loc_ij*sss_ele_grad*rmij*yj
3681 ! ggg(3)=(agg(3,1)*muij(1)+ &
3682 ! agg(3,2)*muij(2)+agg(3,3)*muij(3)+agg(3,4)*muij(4)) &
3684 ! +eel_loc_ij*sss_ele_grad*rmij*zj
3690 ggg(l)=(agg(l,1)*muij(1)+ &
3691 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
3693 *fac_shield(i)*fac_shield(j) &
3694 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) &
3695 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3698 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3699 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3700 !grad ghalf=0.5d0*ggg(l)
3701 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
3702 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
3704 gel_loc_long(3,j)=gel_loc_long(3,j)+ &
3705 ssgradlipj*eel_loc_ij/2.0d0*lipscale/ &
3706 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
3708 gel_loc_long(3,i)=gel_loc_long(3,i)+ &
3709 ssgradlipi*eel_loc_ij/2.0d0*lipscale/ &
3710 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
3714 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3717 ! Remaining derivatives of eello
3719 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
3720 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
3722 *fac_shield(i)*fac_shield(j) &
3723 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3725 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3726 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
3727 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) &
3728 +aggi1(l,4)*muij(4))&
3730 *fac_shield(i)*fac_shield(j) &
3731 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3733 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3734 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
3735 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
3737 *fac_shield(i)*fac_shield(j) &
3738 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3740 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3741 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
3742 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) &
3743 +aggj1(l,4)*muij(4))&
3745 *fac_shield(i)*fac_shield(j) &
3746 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3748 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3751 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
3752 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
3753 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
3754 .and. num_conti.le.maxconts) then
3755 ! write (iout,*) i,j," entered corr"
3757 ! Calculate the contact function. The ith column of the array JCONT will
3758 ! contain the numbers of atoms that make contacts with the atom I (of numbers
3759 ! greater than I). The arrays FACONT and GACONT will contain the values of
3760 ! the contact function and its derivative.
3761 ! r0ij=1.02D0*rpp(iteli,itelj)
3762 ! r0ij=1.11D0*rpp(iteli,itelj)
3763 r0ij=2.20D0*rpp(iteli,itelj)
3764 ! r0ij=1.55D0*rpp(iteli,itelj)
3765 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3766 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
3767 if (fcont.gt.0.0D0) then
3768 num_conti=num_conti+1
3769 if (num_conti.gt.maxconts) then
3770 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
3771 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
3772 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
3773 ' will skip next contacts for this conf.', num_conti
3775 jcont_hb(num_conti,i)=j
3776 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
3777 !d & " jcont_hb",jcont_hb(num_conti,i)
3778 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
3779 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3780 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3782 d_cont(num_conti,i)=rij
3783 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3784 ! --- Electrostatic-interaction matrix ---
3785 a_chuj(1,1,num_conti,i)=a22
3786 a_chuj(1,2,num_conti,i)=a23
3787 a_chuj(2,1,num_conti,i)=a32
3788 a_chuj(2,2,num_conti,i)=a33
3789 ! --- Gradient of rij
3791 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3798 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3799 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3800 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3801 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3802 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3807 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3808 ! Calculate contact energies
3810 wij=cosa-3.0D0*cosb*cosg
3813 ! fac3=dsqrt(-ael6i)/r0ij**3
3814 fac3=dsqrt(-ael6i)*r3ij
3815 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3816 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3817 if (ees0tmp.gt.0) then
3818 ees0pij=dsqrt(ees0tmp)
3822 if (shield_mode.eq.0) then
3826 ees0plist(num_conti,i)=j
3828 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3829 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3830 if (ees0tmp.gt.0) then
3831 ees0mij=dsqrt(ees0tmp)
3836 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
3838 *fac_shield(i)*fac_shield(j)
3840 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
3842 *fac_shield(i)*fac_shield(j)
3844 ! Diagnostics. Comment out or remove after debugging!
3845 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3846 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3847 ! ees0m(num_conti,i)=0.0D0
3849 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3850 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3851 ! Angular derivatives of the contact function
3852 ees0pij1=fac3/ees0pij
3853 ees0mij1=fac3/ees0mij
3854 fac3p=-3.0D0*fac3*rrmij
3855 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3856 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3858 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3859 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3860 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3861 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3862 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3863 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3864 ecosap=ecosa1+ecosa2
3865 ecosbp=ecosb1+ecosb2
3866 ecosgp=ecosg1+ecosg2
3867 ecosam=ecosa1-ecosa2
3868 ecosbm=ecosb1-ecosb2
3869 ecosgm=ecosg1-ecosg2
3878 facont_hb(num_conti,i)=fcont
3879 fprimcont=fprimcont/rij
3880 !d facont_hb(num_conti,i)=1.0D0
3881 ! Following line is for diagnostics.
3884 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3885 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3888 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3889 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3891 gggp(1)=gggp(1)+ees0pijp*xj &
3892 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
3893 gggp(2)=gggp(2)+ees0pijp*yj &
3894 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
3895 gggp(3)=gggp(3)+ees0pijp*zj &
3896 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
3898 gggm(1)=gggm(1)+ees0mijp*xj &
3899 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
3901 gggm(2)=gggm(2)+ees0mijp*yj &
3902 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
3904 gggm(3)=gggm(3)+ees0mijp*zj &
3905 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
3907 ! Derivatives due to the contact function
3908 gacont_hbr(1,num_conti,i)=fprimcont*xj
3909 gacont_hbr(2,num_conti,i)=fprimcont*yj
3910 gacont_hbr(3,num_conti,i)=fprimcont*zj
3913 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
3914 ! following the change of gradient-summation algorithm.
3916 !grad ghalfp=0.5D0*gggp(k)
3917 !grad ghalfm=0.5D0*gggm(k)
3918 gacontp_hb1(k,num_conti,i)= & !ghalfp+
3919 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3920 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
3921 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3923 gacontp_hb2(k,num_conti,i)= & !ghalfp+
3924 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3925 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
3926 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3928 gacontp_hb3(k,num_conti,i)=gggp(k) &
3929 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3931 gacontm_hb1(k,num_conti,i)= & !ghalfm+
3932 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3933 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
3934 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3936 gacontm_hb2(k,num_conti,i)= & !ghalfm+
3937 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3938 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
3939 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3941 gacontm_hb3(k,num_conti,i)=gggm(k) &
3942 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3945 ! Diagnostics. Comment out or remove after debugging!
3947 !diag gacontp_hb1(k,num_conti,i)=0.0D0
3948 !diag gacontp_hb2(k,num_conti,i)=0.0D0
3949 !diag gacontp_hb3(k,num_conti,i)=0.0D0
3950 !diag gacontm_hb1(k,num_conti,i)=0.0D0
3951 !diag gacontm_hb2(k,num_conti,i)=0.0D0
3952 !diag gacontm_hb3(k,num_conti,i)=0.0D0
3955 endif ! num_conti.le.maxconts
3958 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3961 ghalf=0.5d0*agg(l,k)
3962 aggi(l,k)=aggi(l,k)+ghalf
3963 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3964 aggj(l,k)=aggj(l,k)+ghalf
3967 if (j.eq.nres-1 .and. i.lt.j-2) then
3970 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3976 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
3978 end subroutine eelecij
3979 !-----------------------------------------------------------------------------
3980 subroutine eturn3(i,eello_turn3)
3981 ! Third- and fourth-order contributions from turns
3984 ! implicit real*8 (a-h,o-z)
3985 ! include 'DIMENSIONS'
3986 ! include 'COMMON.IOUNITS'
3987 ! include 'COMMON.GEO'
3988 ! include 'COMMON.VAR'
3989 ! include 'COMMON.LOCAL'
3990 ! include 'COMMON.CHAIN'
3991 ! include 'COMMON.DERIV'
3992 ! include 'COMMON.INTERACT'
3993 ! include 'COMMON.CONTACTS'
3994 ! include 'COMMON.TORSION'
3995 ! include 'COMMON.VECTORS'
3996 ! include 'COMMON.FFIELD'
3997 ! include 'COMMON.CONTROL'
3998 real(kind=8),dimension(3) :: ggg
3999 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4000 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4001 real(kind=8),dimension(2) :: auxvec,auxvec1
4002 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4003 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
4004 !el integer :: num_conti,j1,j2
4005 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4006 !el dz_normi,xmedi,ymedi,zmedi
4008 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4009 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4012 integer :: i,j,l,k,ilist,iresshield
4013 real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield
4016 ! write (iout,*) "eturn3",i,j,j1,j2
4017 zj=(c(3,j)+c(3,j+1))/2.0d0
4019 if (zj.lt.0) zj=zj+boxzsize
4020 if ((zj.lt.0)) write (*,*) "CHUJ"
4021 if ((zj.gt.bordlipbot) &
4022 .and.(zj.lt.bordliptop)) then
4023 !C the energy transfer exist
4024 if (zj.lt.buflipbot) then
4025 !C what fraction I am in
4027 ((zj-bordlipbot)/lipbufthick)
4028 !C lipbufthick is thickenes of lipid buffore
4029 sslipj=sscalelip(fracinbuf)
4030 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4031 elseif (zj.gt.bufliptop) then
4032 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4033 sslipj=sscalelip(fracinbuf)
4034 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4048 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4050 ! Third-order contributions
4057 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4058 !d call checkint_turn3(i,a_temp,eello_turn3_num)
4059 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4060 call transpose2(auxmat(1,1),auxmat1(1,1))
4061 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4062 if (shield_mode.eq.0) then
4067 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) &
4068 *fac_shield(i)*fac_shield(j) &
4069 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4071 0.5d0*(pizda(1,1)+pizda(2,2)) &
4072 *fac_shield(i)*fac_shield(j)
4074 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4075 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4076 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4077 (shield_mode.gt.0)) then
4080 do ilist=1,ishield_list(i)
4081 iresshield=shield_list(ilist,i)
4083 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4084 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4086 +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4087 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4091 do ilist=1,ishield_list(j)
4092 iresshield=shield_list(ilist,j)
4094 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4095 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4097 +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4098 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4105 gshieldc_t3(k,i)=gshieldc_t3(k,i)+ &
4106 grad_shield(k,i)*eello_t3/fac_shield(i)
4107 gshieldc_t3(k,j)=gshieldc_t3(k,j)+ &
4108 grad_shield(k,j)*eello_t3/fac_shield(j)
4109 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ &
4110 grad_shield(k,i)*eello_t3/fac_shield(i)
4111 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ &
4112 grad_shield(k,j)*eello_t3/fac_shield(j)
4116 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
4117 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
4118 !d & ' eello_turn3_num',4*eello_turn3_num
4119 ! Derivatives in gamma(i)
4120 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4121 call transpose2(auxmat2(1,1),auxmat3(1,1))
4122 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4123 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))&
4124 *fac_shield(i)*fac_shield(j) &
4125 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4126 ! Derivatives in gamma(i+1)
4127 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4128 call transpose2(auxmat2(1,1),auxmat3(1,1))
4129 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4130 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
4131 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4132 *fac_shield(i)*fac_shield(j) &
4133 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4135 ! Cartesian derivatives
4137 ! ghalf1=0.5d0*agg(l,1)
4138 ! ghalf2=0.5d0*agg(l,2)
4139 ! ghalf3=0.5d0*agg(l,3)
4140 ! ghalf4=0.5d0*agg(l,4)
4141 a_temp(1,1)=aggi(l,1)!+ghalf1
4142 a_temp(1,2)=aggi(l,2)!+ghalf2
4143 a_temp(2,1)=aggi(l,3)!+ghalf3
4144 a_temp(2,2)=aggi(l,4)!+ghalf4
4145 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4146 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
4147 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4148 *fac_shield(i)*fac_shield(j) &
4149 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4151 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4152 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4153 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4154 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4155 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4156 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
4157 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4158 *fac_shield(i)*fac_shield(j) &
4159 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4161 a_temp(1,1)=aggj(l,1)!+ghalf1
4162 a_temp(1,2)=aggj(l,2)!+ghalf2
4163 a_temp(2,1)=aggj(l,3)!+ghalf3
4164 a_temp(2,2)=aggj(l,4)!+ghalf4
4165 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4166 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
4167 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4168 *fac_shield(i)*fac_shield(j) &
4169 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4171 a_temp(1,1)=aggj1(l,1)
4172 a_temp(1,2)=aggj1(l,2)
4173 a_temp(2,1)=aggj1(l,3)
4174 a_temp(2,2)=aggj1(l,4)
4175 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4176 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
4177 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4178 *fac_shield(i)*fac_shield(j) &
4179 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4181 gshieldc_t3(3,i)=gshieldc_t3(3,i)+ &
4182 ssgradlipi*eello_t3/4.0d0*lipscale
4183 gshieldc_t3(3,j)=gshieldc_t3(3,j)+ &
4184 ssgradlipj*eello_t3/4.0d0*lipscale
4185 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+ &
4186 ssgradlipi*eello_t3/4.0d0*lipscale
4187 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+ &
4188 ssgradlipj*eello_t3/4.0d0*lipscale
4191 end subroutine eturn3
4192 !-----------------------------------------------------------------------------
4193 subroutine eturn4(i,eello_turn4)
4194 ! Third- and fourth-order contributions from turns
4197 ! implicit real*8 (a-h,o-z)
4198 ! include 'DIMENSIONS'
4199 ! include 'COMMON.IOUNITS'
4200 ! include 'COMMON.GEO'
4201 ! include 'COMMON.VAR'
4202 ! include 'COMMON.LOCAL'
4203 ! include 'COMMON.CHAIN'
4204 ! include 'COMMON.DERIV'
4205 ! include 'COMMON.INTERACT'
4206 ! include 'COMMON.CONTACTS'
4207 ! include 'COMMON.TORSION'
4208 ! include 'COMMON.VECTORS'
4209 ! include 'COMMON.FFIELD'
4210 ! include 'COMMON.CONTROL'
4211 real(kind=8),dimension(3) :: ggg
4212 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4213 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4214 real(kind=8),dimension(2) :: auxvec,auxvec1
4215 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4216 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
4217 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4218 !el dz_normi,xmedi,ymedi,zmedi
4219 !el integer :: num_conti,j1,j2
4220 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4221 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4224 integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
4225 real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
4229 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4231 ! Fourth-order contributions
4239 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4240 !d call checkint_turn4(i,a_temp,eello_turn4_num)
4241 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4242 zj=(c(3,j)+c(3,j+1))/2.0d0
4244 if (zj.lt.0) zj=zj+boxzsize
4245 if ((zj.gt.bordlipbot) &
4246 .and.(zj.lt.bordliptop)) then
4247 !C the energy transfer exist
4248 if (zj.lt.buflipbot) then
4249 !C what fraction I am in
4251 ((zj-bordlipbot)/lipbufthick)
4252 !C lipbufthick is thickenes of lipid buffore
4253 sslipj=sscalelip(fracinbuf)
4254 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4255 elseif (zj.gt.bufliptop) then
4256 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4257 sslipj=sscalelip(fracinbuf)
4258 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4272 iti1=itortyp(itype(i+1))
4273 iti2=itortyp(itype(i+2))
4274 iti3=itortyp(itype(i+3))
4275 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4276 call transpose2(EUg(1,1,i+1),e1t(1,1))
4277 call transpose2(Eug(1,1,i+2),e2t(1,1))
4278 call transpose2(Eug(1,1,i+3),e3t(1,1))
4279 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4280 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4281 s1=scalar2(b1(1,iti2),auxvec(1))
4282 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4283 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4284 s2=scalar2(b1(1,iti1),auxvec(1))
4285 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4286 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4287 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4288 if (shield_mode.eq.0) then
4293 eello_turn4=eello_turn4-(s1+s2+s3) &
4294 *fac_shield(i)*fac_shield(j) &
4295 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4296 eello_t4=-(s1+s2+s3) &
4297 *fac_shield(i)*fac_shield(j)
4298 !C Now derivative over shield:
4299 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4300 (shield_mode.gt.0)) then
4303 do ilist=1,ishield_list(i)
4304 iresshield=shield_list(ilist,i)
4306 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
4307 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4309 +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
4310 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4314 do ilist=1,ishield_list(j)
4315 iresshield=shield_list(ilist,j)
4317 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
4318 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4320 +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
4321 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4328 gshieldc_t4(k,i)=gshieldc_t4(k,i)+ &
4329 grad_shield(k,i)*eello_t4/fac_shield(i)
4330 gshieldc_t4(k,j)=gshieldc_t4(k,j)+ &
4331 grad_shield(k,j)*eello_t4/fac_shield(j)
4332 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ &
4333 grad_shield(k,i)*eello_t4/fac_shield(i)
4334 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ &
4335 grad_shield(k,j)*eello_t4/fac_shield(j)
4339 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4340 'eturn4',i,j,-(s1+s2+s3)
4341 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4342 !d & ' eello_turn4_num',8*eello_turn4_num
4343 ! Derivatives in gamma(i)
4344 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4345 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4346 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4347 s1=scalar2(b1(1,iti2),auxvec(1))
4348 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4349 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4350 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) &
4351 *fac_shield(i)*fac_shield(j) &
4352 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4354 ! Derivatives in gamma(i+1)
4355 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4356 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4357 s2=scalar2(b1(1,iti1),auxvec(1))
4358 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4359 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4360 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4361 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) &
4362 *fac_shield(i)*fac_shield(j) &
4363 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4365 ! Derivatives in gamma(i+2)
4366 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4367 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4368 s1=scalar2(b1(1,iti2),auxvec(1))
4369 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4370 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4371 s2=scalar2(b1(1,iti1),auxvec(1))
4372 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4373 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4374 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4375 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) &
4376 *fac_shield(i)*fac_shield(j) &
4377 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4379 ! Cartesian derivatives
4380 ! Derivatives of this turn contributions in DC(i+2)
4381 if (j.lt.nres-1) then
4383 a_temp(1,1)=agg(l,1)
4384 a_temp(1,2)=agg(l,2)
4385 a_temp(2,1)=agg(l,3)
4386 a_temp(2,2)=agg(l,4)
4387 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4388 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4389 s1=scalar2(b1(1,iti2),auxvec(1))
4390 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4391 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4392 s2=scalar2(b1(1,iti1),auxvec(1))
4393 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4394 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4395 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4397 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)&
4398 *fac_shield(i)*fac_shield(j) &
4399 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4403 ! Remaining derivatives of this turn contribution
4405 a_temp(1,1)=aggi(l,1)
4406 a_temp(1,2)=aggi(l,2)
4407 a_temp(2,1)=aggi(l,3)
4408 a_temp(2,2)=aggi(l,4)
4409 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4410 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4411 s1=scalar2(b1(1,iti2),auxvec(1))
4412 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4413 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4414 s2=scalar2(b1(1,iti1),auxvec(1))
4415 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4416 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4417 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4418 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) &
4419 *fac_shield(i)*fac_shield(j) &
4420 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4423 a_temp(1,1)=aggi1(l,1)
4424 a_temp(1,2)=aggi1(l,2)
4425 a_temp(2,1)=aggi1(l,3)
4426 a_temp(2,2)=aggi1(l,4)
4427 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4428 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4429 s1=scalar2(b1(1,iti2),auxvec(1))
4430 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4431 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4432 s2=scalar2(b1(1,iti1),auxvec(1))
4433 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4434 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4435 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4436 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) &
4437 *fac_shield(i)*fac_shield(j) &
4438 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4441 a_temp(1,1)=aggj(l,1)
4442 a_temp(1,2)=aggj(l,2)
4443 a_temp(2,1)=aggj(l,3)
4444 a_temp(2,2)=aggj(l,4)
4445 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4446 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4447 s1=scalar2(b1(1,iti2),auxvec(1))
4448 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4449 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4450 s2=scalar2(b1(1,iti1),auxvec(1))
4451 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4452 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4453 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4454 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) &
4455 *fac_shield(i)*fac_shield(j) &
4456 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4459 a_temp(1,1)=aggj1(l,1)
4460 a_temp(1,2)=aggj1(l,2)
4461 a_temp(2,1)=aggj1(l,3)
4462 a_temp(2,2)=aggj1(l,4)
4463 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4464 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4465 s1=scalar2(b1(1,iti2),auxvec(1))
4466 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4467 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4468 s2=scalar2(b1(1,iti1),auxvec(1))
4469 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4470 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4471 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4472 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4473 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) &
4474 *fac_shield(i)*fac_shield(j) &
4475 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4478 gshieldc_t4(3,i)=gshieldc_t4(3,i)+ &
4479 ssgradlipi*eello_t4/4.0d0*lipscale
4480 gshieldc_t4(3,j)=gshieldc_t4(3,j)+ &
4481 ssgradlipj*eello_t4/4.0d0*lipscale
4482 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+ &
4483 ssgradlipi*eello_t4/4.0d0*lipscale
4484 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+ &
4485 ssgradlipj*eello_t4/4.0d0*lipscale
4488 end subroutine eturn4
4489 !-----------------------------------------------------------------------------
4490 subroutine unormderiv(u,ugrad,unorm,ungrad)
4491 ! This subroutine computes the derivatives of a normalized vector u, given
4492 ! the derivatives computed without normalization conditions, ugrad. Returns
4495 real(kind=8),dimension(3) :: u,vec
4496 real(kind=8),dimension(3,3) ::ugrad,ungrad
4497 real(kind=8) :: unorm !,scalar
4499 ! write (2,*) 'ugrad',ugrad
4502 vec(i)=scalar(ugrad(1,i),u(1))
4504 ! write (2,*) 'vec',vec
4507 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4510 ! write (2,*) 'ungrad',ungrad
4512 end subroutine unormderiv
4513 !-----------------------------------------------------------------------------
4514 subroutine escp_soft_sphere(evdw2,evdw2_14)
4516 ! This subroutine calculates the excluded-volume interaction energy between
4517 ! peptide-group centers and side chains and its gradient in virtual-bond and
4518 ! side-chain vectors.
4520 ! implicit real*8 (a-h,o-z)
4521 ! include 'DIMENSIONS'
4522 ! include 'COMMON.GEO'
4523 ! include 'COMMON.VAR'
4524 ! include 'COMMON.LOCAL'
4525 ! include 'COMMON.CHAIN'
4526 ! include 'COMMON.DERIV'
4527 ! include 'COMMON.INTERACT'
4528 ! include 'COMMON.FFIELD'
4529 ! include 'COMMON.IOUNITS'
4530 ! include 'COMMON.CONTROL'
4531 real(kind=8),dimension(3) :: ggg
4533 integer :: i,iint,j,k,iteli,itypj
4534 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
4535 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
4540 !d print '(a)','Enter ESCP'
4541 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4542 do i=iatscp_s,iatscp_e
4543 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4545 xi=0.5D0*(c(1,i)+c(1,i+1))
4546 yi=0.5D0*(c(2,i)+c(2,i+1))
4547 zi=0.5D0*(c(3,i)+c(3,i+1))
4549 do iint=1,nscp_gr(i)
4551 do j=iscpstart(i,iint),iscpend(i,iint)
4552 if (itype(j).eq.ntyp1) cycle
4553 itypj=iabs(itype(j))
4554 ! Uncomment following three lines for SC-p interactions
4558 ! Uncomment following three lines for Ca-p interactions
4562 rij=xj*xj+yj*yj+zj*zj
4565 if (rij.lt.r0ijsq) then
4566 evdwij=0.25d0*(rij-r0ijsq)**2
4574 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
4579 !grad if (j.lt.i) then
4580 !d write (iout,*) 'j<i'
4581 ! Uncomment following three lines for SC-p interactions
4583 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4586 !d write (iout,*) 'j>i'
4588 !grad ggg(k)=-ggg(k)
4589 ! Uncomment following line for SC-p interactions
4590 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4594 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4596 !grad kstart=min0(i+1,j)
4597 !grad kend=max0(i-1,j-1)
4598 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4599 !d write (iout,*) ggg(1),ggg(2),ggg(3)
4600 !grad do k=kstart,kend
4602 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4606 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4607 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4614 end subroutine escp_soft_sphere
4615 !-----------------------------------------------------------------------------
4616 subroutine escp(evdw2,evdw2_14)
4618 ! This subroutine calculates the excluded-volume interaction energy between
4619 ! peptide-group centers and side chains and its gradient in virtual-bond and
4620 ! side-chain vectors.
4622 ! implicit real*8 (a-h,o-z)
4623 ! include 'DIMENSIONS'
4624 ! include 'COMMON.GEO'
4625 ! include 'COMMON.VAR'
4626 ! include 'COMMON.LOCAL'
4627 ! include 'COMMON.CHAIN'
4628 ! include 'COMMON.DERIV'
4629 ! include 'COMMON.INTERACT'
4630 ! include 'COMMON.FFIELD'
4631 ! include 'COMMON.IOUNITS'
4632 ! include 'COMMON.CONTROL'
4633 real(kind=8),dimension(3) :: ggg
4635 integer :: i,iint,j,k,iteli,itypj,subchap
4636 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
4638 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
4639 dist_temp, dist_init
4640 integer xshift,yshift,zshift
4644 !d print '(a)','Enter ESCP'
4645 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4646 do i=iatscp_s,iatscp_e
4647 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4649 xi=0.5D0*(c(1,i)+c(1,i+1))
4650 yi=0.5D0*(c(2,i)+c(2,i+1))
4651 zi=0.5D0*(c(3,i)+c(3,i+1))
4653 if (xi.lt.0) xi=xi+boxxsize
4655 if (yi.lt.0) yi=yi+boxysize
4657 if (zi.lt.0) zi=zi+boxzsize
4659 do iint=1,nscp_gr(i)
4661 do j=iscpstart(i,iint),iscpend(i,iint)
4662 itypj=iabs(itype(j))
4663 if (itypj.eq.ntyp1) cycle
4664 ! Uncomment following three lines for SC-p interactions
4668 ! Uncomment following three lines for Ca-p interactions
4676 if (xj.lt.0) xj=xj+boxxsize
4678 if (yj.lt.0) yj=yj+boxysize
4680 if (zj.lt.0) zj=zj+boxzsize
4681 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4689 xj=xj_safe+xshift*boxxsize
4690 yj=yj_safe+yshift*boxysize
4691 zj=zj_safe+zshift*boxzsize
4692 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4693 if(dist_temp.lt.dist_init) then
4703 if (subchap.eq.1) then
4713 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4714 rij=dsqrt(1.0d0/rrij)
4715 sss_ele_cut=sscale_ele(rij)
4716 sss_ele_grad=sscagrad_ele(rij)
4717 ! print *,sss_ele_cut,sss_ele_grad,&
4718 ! (rij),r_cut_ele,rlamb_ele
4719 if (sss_ele_cut.le.0.0) cycle
4721 e1=fac*fac*aad(itypj,iteli)
4722 e2=fac*bad(itypj,iteli)
4723 if (iabs(j-i) .le. 2) then
4726 evdw2_14=evdw2_14+(e1+e2)*sss_ele_cut
4729 evdw2=evdw2+evdwij*sss_ele_cut
4730 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
4731 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
4732 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4735 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
4737 fac=-(evdwij+e1)*rrij*sss_ele_cut
4738 fac=fac+evdwij*sss_ele_grad/rij/expon
4742 !grad if (j.lt.i) then
4743 !d write (iout,*) 'j<i'
4744 ! Uncomment following three lines for SC-p interactions
4746 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4749 !d write (iout,*) 'j>i'
4751 !grad ggg(k)=-ggg(k)
4752 ! Uncomment following line for SC-p interactions
4753 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4754 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4758 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4760 !grad kstart=min0(i+1,j)
4761 !grad kend=max0(i-1,j-1)
4762 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4763 !d write (iout,*) ggg(1),ggg(2),ggg(3)
4764 !grad do k=kstart,kend
4766 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4770 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4771 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4779 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4780 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4781 gradx_scp(j,i)=expon*gradx_scp(j,i)
4784 !******************************************************************************
4788 ! To save time the factor EXPON has been extracted from ALL components
4789 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
4792 !******************************************************************************
4795 !-----------------------------------------------------------------------------
4796 subroutine edis(ehpb)
4798 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4800 ! implicit real*8 (a-h,o-z)
4801 ! include 'DIMENSIONS'
4802 ! include 'COMMON.SBRIDGE'
4803 ! include 'COMMON.CHAIN'
4804 ! include 'COMMON.DERIV'
4805 ! include 'COMMON.VAR'
4806 ! include 'COMMON.INTERACT'
4807 ! include 'COMMON.IOUNITS'
4808 real(kind=8),dimension(3) :: ggg
4810 integer :: i,j,ii,jj,iii,jjj,k
4811 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
4814 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4815 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
4816 if (link_end.eq.0) return
4817 do i=link_start,link_end
4818 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4819 ! CA-CA distance used in regularization of structure.
4822 ! iii and jjj point to the residues for which the distance is assigned.
4823 if (ii.gt.nres) then
4830 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4831 ! & dhpb(i),dhpb1(i),forcon(i)
4832 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
4833 ! distance and angle dependent SS bond potential.
4834 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4835 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4836 if (.not.dyn_ss .and. i.le.nss) then
4837 ! 15/02/13 CC dynamic SSbond - additional check
4838 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. &
4839 iabs(itype(jjj)).eq.1) then
4840 call ssbond_ene(iii,jjj,eij)
4842 !d write (iout,*) "eij",eij
4845 ! Calculate the distance between the two points and its difference from the
4849 ! Get the force constant corresponding to this distance.
4851 ! Calculate the contribution to energy.
4852 ehpb=ehpb+waga*rdis*rdis
4854 ! Evaluate gradient.
4857 !d print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4858 !d & ' waga=',waga,' fac=',fac
4860 ggg(j)=fac*(c(j,jj)-c(j,ii))
4862 !d print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4863 ! If this is a SC-SC distance, we need to calculate the contributions to the
4864 ! Cartesian gradient in the SC vectors (ghpbx).
4867 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4868 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4871 !grad do j=iii,jjj-1
4873 !grad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4877 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4878 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4885 !-----------------------------------------------------------------------------
4886 subroutine ssbond_ene(i,j,eij)
4888 ! Calculate the distance and angle dependent SS-bond potential energy
4889 ! using a free-energy function derived based on RHF/6-31G** ab initio
4890 ! calculations of diethyl disulfide.
4892 ! A. Liwo and U. Kozlowska, 11/24/03
4894 ! implicit real*8 (a-h,o-z)
4895 ! include 'DIMENSIONS'
4896 ! include 'COMMON.SBRIDGE'
4897 ! include 'COMMON.CHAIN'
4898 ! include 'COMMON.DERIV'
4899 ! include 'COMMON.LOCAL'
4900 ! include 'COMMON.INTERACT'
4901 ! include 'COMMON.VAR'
4902 ! include 'COMMON.IOUNITS'
4903 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
4905 integer :: i,j,itypi,itypj,k
4906 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
4907 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
4908 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
4911 itypi=iabs(itype(i))
4915 dxi=dc_norm(1,nres+i)
4916 dyi=dc_norm(2,nres+i)
4917 dzi=dc_norm(3,nres+i)
4918 ! dsci_inv=dsc_inv(itypi)
4919 dsci_inv=vbld_inv(nres+i)
4920 itypj=iabs(itype(j))
4921 ! dscj_inv=dsc_inv(itypj)
4922 dscj_inv=vbld_inv(nres+j)
4926 dxj=dc_norm(1,nres+j)
4927 dyj=dc_norm(2,nres+j)
4928 dzj=dc_norm(3,nres+j)
4929 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4934 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4935 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4936 om12=dxi*dxj+dyi*dyj+dzi*dzj
4938 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4939 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4945 deltat12=om2-om1+2.0d0
4947 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
4948 +akct*deltad*deltat12 &
4949 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4950 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4951 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4952 ! & " deltat12",deltat12," eij",eij
4953 ed=2*akcm*deltad+akct*deltat12
4955 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4956 eom1=-2*akth*deltat1-pom1-om2*pom2
4957 eom2= 2*akth*deltat2+pom1-om1*pom2
4960 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4961 ghpbx(k,i)=ghpbx(k,i)-ggk &
4962 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
4963 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4964 ghpbx(k,j)=ghpbx(k,j)+ggk &
4965 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
4966 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4967 ghpbc(k,i)=ghpbc(k,i)-ggk
4968 ghpbc(k,j)=ghpbc(k,j)+ggk
4971 ! Calculate the components of the gradient in DC and X
4975 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4979 end subroutine ssbond_ene
4980 !-----------------------------------------------------------------------------
4981 subroutine ebond(estr)
4983 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4985 ! implicit real*8 (a-h,o-z)
4986 ! include 'DIMENSIONS'
4987 ! include 'COMMON.LOCAL'
4988 ! include 'COMMON.GEO'
4989 ! include 'COMMON.INTERACT'
4990 ! include 'COMMON.DERIV'
4991 ! include 'COMMON.VAR'
4992 ! include 'COMMON.CHAIN'
4993 ! include 'COMMON.IOUNITS'
4994 ! include 'COMMON.NAMES'
4995 ! include 'COMMON.FFIELD'
4996 ! include 'COMMON.CONTROL'
4997 ! include 'COMMON.SETUP'
4998 real(kind=8),dimension(3) :: u,ud
5000 integer :: i,j,iti,nbi,k
5001 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
5006 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
5007 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
5009 do i=ibondp_start,ibondp_end
5010 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5011 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5012 !C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5014 !C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
5015 !C *dc(j,i-1)/vbld(i)
5017 !C if (energy_dec) write(iout,*) &
5018 !C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5019 diff = vbld(i)-vbldpDUM
5021 diff = vbld(i)-vbldp0
5023 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
5024 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5027 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5029 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5032 estr=0.5d0*AKP*estr+estr1
5034 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5036 do i=ibond_start,ibond_end
5038 if (iti.ne.10 .and. iti.ne.ntyp1) then
5041 diff=vbld(i+nres)-vbldsc0(1,iti)
5042 if (energy_dec) write (iout,*) &
5043 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5044 AKSC(1,iti),AKSC(1,iti)*diff*diff
5045 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5047 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5051 diff=vbld(i+nres)-vbldsc0(j,iti)
5052 ud(j)=aksc(j,iti)*diff
5053 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5067 uprod2=uprod2*u(k)*u(k)
5071 usumsqder=usumsqder+ud(j)*uprod2
5073 estr=estr+uprod/usum
5075 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5081 end subroutine ebond
5083 !-----------------------------------------------------------------------------
5084 subroutine ebend(etheta)
5086 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5087 ! angles gamma and its derivatives in consecutive thetas and gammas.
5090 ! implicit real*8 (a-h,o-z)
5091 ! include 'DIMENSIONS'
5092 ! include 'COMMON.LOCAL'
5093 ! include 'COMMON.GEO'
5094 ! include 'COMMON.INTERACT'
5095 ! include 'COMMON.DERIV'
5096 ! include 'COMMON.VAR'
5097 ! include 'COMMON.CHAIN'
5098 ! include 'COMMON.IOUNITS'
5099 ! include 'COMMON.NAMES'
5100 ! include 'COMMON.FFIELD'
5101 ! include 'COMMON.CONTROL'
5102 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5103 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5104 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5106 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5107 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5108 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5110 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
5112 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
5113 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
5114 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
5115 real(kind=8),dimension(2) :: y,z
5118 ! time11=dexp(-2*time)
5121 ! write (*,'(a,i2)') 'EBEND ICG=',icg
5122 do i=ithet_start,ithet_end
5123 if (itype(i-1).eq.ntyp1) cycle
5124 ! Zero the energy function and its derivative at 0 or pi.
5125 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5127 ichir1=isign(1,itype(i-2))
5128 ichir2=isign(1,itype(i))
5129 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5130 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5131 if (itype(i-1).eq.10) then
5132 itype1=isign(10,itype(i-2))
5133 ichir11=isign(1,itype(i-2))
5134 ichir12=isign(1,itype(i-2))
5135 itype2=isign(10,itype(i))
5136 ichir21=isign(1,itype(i))
5137 ichir22=isign(1,itype(i))
5140 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
5143 if (phii.ne.phii) phii=150.0
5153 if (i.lt.nres .and. itype(i).ne.ntyp1) then
5156 if (phii1.ne.phii1) phii1=150.0
5168 ! Calculate the "mean" value of theta from the part of the distribution
5169 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5170 ! In following comments this theta will be referred to as t_c.
5171 thet_pred_mean=0.0d0
5173 athetk=athet(k,it,ichir1,ichir2)
5174 bthetk=bthet(k,it,ichir1,ichir2)
5176 athetk=athet(k,itype1,ichir11,ichir12)
5177 bthetk=bthet(k,itype2,ichir21,ichir22)
5179 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5181 dthett=thet_pred_mean*ssd
5182 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5183 ! Derivatives of the "mean" values in gamma1 and gamma2.
5184 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
5185 +athet(2,it,ichir1,ichir2)*y(1))*ss
5186 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
5187 +bthet(2,it,ichir1,ichir2)*z(1))*ss
5189 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
5190 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
5191 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
5192 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5194 if (theta(i).gt.pi-delta) then
5195 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
5197 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5198 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5199 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
5201 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
5203 else if (theta(i).lt.delta) then
5204 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5205 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5206 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
5208 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5209 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
5212 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
5215 etheta=etheta+ethetai
5216 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5218 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5219 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5220 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5222 ! Ufff.... We've done all this!!!
5224 end subroutine ebend
5225 !-----------------------------------------------------------------------------
5226 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
5229 ! implicit real*8 (a-h,o-z)
5230 ! include 'DIMENSIONS'
5231 ! include 'COMMON.LOCAL'
5232 ! include 'COMMON.IOUNITS'
5233 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5234 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5235 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5237 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
5239 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5240 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5241 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5243 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
5244 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5246 ! Calculate the contributions to both Gaussian lobes.
5247 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5248 ! The "polynomial part" of the "standard deviation" of this part of
5252 sig=sig*thet_pred_mean+polthet(j,it)
5254 ! Derivative of the "interior part" of the "standard deviation of the"
5255 ! gamma-dependent Gaussian lobe in t_c.
5256 sigtc=3*polthet(3,it)
5258 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5261 ! Set the parameters of both Gaussian lobes of the distribution.
5262 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5263 fac=sig*sig+sigc0(it)
5266 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5267 sigsqtc=-4.0D0*sigcsq*sigtc
5268 ! print *,i,sig,sigtc,sigsqtc
5269 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
5270 sigtc=-sigtc/(fac*fac)
5271 ! Following variable is sigma(t_c)**(-2)
5272 sigcsq=sigcsq*sigcsq
5274 sig0inv=1.0D0/sig0i**2
5275 delthec=thetai-thet_pred_mean
5276 delthe0=thetai-theta0i
5277 term1=-0.5D0*sigcsq*delthec*delthec
5278 term2=-0.5D0*sig0inv*delthe0*delthe0
5279 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5280 ! NaNs in taking the logarithm. We extract the largest exponent which is added
5281 ! to the energy (this being the log of the distribution) at the end of energy
5282 ! term evaluation for this virtual-bond angle.
5283 if (term1.gt.term2) then
5285 term2=dexp(term2-termm)
5289 term1=dexp(term1-termm)
5292 ! The ratio between the gamma-independent and gamma-dependent lobes of
5293 ! the distribution is a Gaussian function of thet_pred_mean too.
5294 diffak=gthet(2,it)-thet_pred_mean
5295 ratak=diffak/gthet(3,it)**2
5296 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5297 ! Let's differentiate it in thet_pred_mean NOW.
5299 ! Now put together the distribution terms to make complete distribution.
5300 termexp=term1+ak*term2
5301 termpre=sigc+ak*sig0i
5302 ! Contribution of the bending energy from this theta is just the -log of
5303 ! the sum of the contributions from the two lobes and the pre-exponential
5304 ! factor. Simple enough, isn't it?
5305 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5306 ! NOW the derivatives!!!
5307 ! 6/6/97 Take into account the deformation.
5308 E_theta=(delthec*sigcsq*term1 &
5309 +ak*delthe0*sig0inv*term2)/termexp
5310 E_tc=((sigtc+aktc*sig0i)/termpre &
5311 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
5312 aktc*term2)/termexp)
5314 end subroutine theteng
5316 !-----------------------------------------------------------------------------
5317 subroutine ebend(etheta)
5319 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5320 ! angles gamma and its derivatives in consecutive thetas and gammas.
5321 ! ab initio-derived potentials from
5322 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5324 ! implicit real*8 (a-h,o-z)
5325 ! include 'DIMENSIONS'
5326 ! include 'COMMON.LOCAL'
5327 ! include 'COMMON.GEO'
5328 ! include 'COMMON.INTERACT'
5329 ! include 'COMMON.DERIV'
5330 ! include 'COMMON.VAR'
5331 ! include 'COMMON.CHAIN'
5332 ! include 'COMMON.IOUNITS'
5333 ! include 'COMMON.NAMES'
5334 ! include 'COMMON.FFIELD'
5335 ! include 'COMMON.CONTROL'
5336 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
5337 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
5338 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
5339 logical :: lprn=.false., lprn1=.false.
5341 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
5342 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
5343 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl
5346 do i=ithet_start,ithet_end
5347 if (itype(i-1).eq.ntyp1) cycle
5348 if (itype(i-2).eq.ntyp1.or.itype(i).eq.ntyp1) cycle
5349 if (iabs(itype(i+1)).eq.20) iblock=2
5350 if (iabs(itype(i+1)).ne.20) iblock=1
5354 theti2=0.5d0*theta(i)
5355 ityp2=ithetyp((itype(i-1)))
5357 coskt(k)=dcos(k*theti2)
5358 sinkt(k)=dsin(k*theti2)
5360 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
5363 if (phii.ne.phii) phii=150.0
5367 ityp1=ithetyp((itype(i-2)))
5368 ! propagation of chirality for glycine type
5370 cosph1(k)=dcos(k*phii)
5371 sinph1(k)=dsin(k*phii)
5375 ityp1=ithetyp(itype(i-2))
5381 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5384 if (phii1.ne.phii1) phii1=150.0
5389 ityp3=ithetyp((itype(i)))
5391 cosph2(k)=dcos(k*phii1)
5392 sinph2(k)=dsin(k*phii1)
5396 ityp3=ithetyp(itype(i))
5402 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5405 ccl=cosph1(l)*cosph2(k-l)
5406 ssl=sinph1(l)*sinph2(k-l)
5407 scl=sinph1(l)*cosph2(k-l)
5408 csl=cosph1(l)*sinph2(k-l)
5409 cosph1ph2(l,k)=ccl-ssl
5410 cosph1ph2(k,l)=ccl+ssl
5411 sinph1ph2(l,k)=scl+csl
5412 sinph1ph2(k,l)=scl-csl
5416 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
5417 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5418 write (iout,*) "coskt and sinkt"
5420 write (iout,*) k,coskt(k),sinkt(k)
5424 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5425 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
5428 write (iout,*) "k",k,&
5429 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
5433 write (iout,*) "cosph and sinph"
5435 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5437 write (iout,*) "cosph1ph2 and sinph2ph2"
5440 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
5441 sinph1ph2(l,k),sinph1ph2(k,l)
5444 write(iout,*) "ethetai",ethetai
5448 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
5449 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
5450 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
5451 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5452 ethetai=ethetai+sinkt(m)*aux
5453 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5454 dephii=dephii+k*sinkt(m)* &
5455 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
5456 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5457 dephii1=dephii1+k*sinkt(m)* &
5458 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
5459 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5461 write (iout,*) "m",m," k",k," bbthet", &
5462 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
5463 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
5464 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
5465 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5469 write(iout,*) "ethetai",ethetai
5473 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5474 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
5475 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5476 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5477 ethetai=ethetai+sinkt(m)*aux
5478 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5479 dephii=dephii+l*sinkt(m)* &
5480 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
5481 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5482 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5483 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5484 dephii1=dephii1+(k-l)*sinkt(m)* &
5485 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5486 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5487 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
5488 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5490 write (iout,*) "m",m," k",k," l",l," ffthet",&
5491 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5492 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
5493 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5494 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
5496 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
5497 cosph1ph2(k,l)*sinkt(m),&
5498 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5506 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
5507 i,theta(i)*rad2deg,phii*rad2deg,&
5508 phii1*rad2deg,ethetai
5510 etheta=etheta+ethetai
5511 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5513 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5514 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5515 gloc(nphi+i-2,icg)=wang*dethetai
5518 end subroutine ebend
5521 !-----------------------------------------------------------------------------
5522 subroutine esc(escloc)
5523 ! Calculate the local energy of a side chain and its derivatives in the
5524 ! corresponding virtual-bond valence angles THETA and the spherical angles
5528 ! implicit real*8 (a-h,o-z)
5529 ! include 'DIMENSIONS'
5530 ! include 'COMMON.GEO'
5531 ! include 'COMMON.LOCAL'
5532 ! include 'COMMON.VAR'
5533 ! include 'COMMON.INTERACT'
5534 ! include 'COMMON.DERIV'
5535 ! include 'COMMON.CHAIN'
5536 ! include 'COMMON.IOUNITS'
5537 ! include 'COMMON.NAMES'
5538 ! include 'COMMON.FFIELD'
5539 ! include 'COMMON.CONTROL'
5540 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
5541 ddersc0,ddummy,xtemp,temp
5542 !el real(kind=8) :: time11,time12,time112,theti
5543 real(kind=8) :: escloc,delta
5544 !el integer :: it,nlobit
5545 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5548 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
5549 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5552 ! write (iout,'(a)') 'ESC'
5553 do i=loc_start,loc_end
5555 if (it.eq.ntyp1) cycle
5556 if (it.eq.10) goto 1
5557 nlobit=nlob(iabs(it))
5558 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
5559 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5560 theti=theta(i+1)-pipol
5565 if (x(2).gt.pi-delta) then
5569 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5571 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5572 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
5574 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5575 ddersc0(1),dersc(1))
5576 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
5577 ddersc0(3),dersc(3))
5579 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5581 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5582 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
5583 dersc0(2),esclocbi,dersc02)
5584 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5586 call splinthet(x(2),0.5d0*delta,ss,ssd)
5591 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5593 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5594 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5596 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5598 ! write (iout,*) escloci
5599 else if (x(2).lt.delta) then
5603 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5605 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5606 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
5608 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
5609 ddersc0(1),dersc(1))
5610 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
5611 ddersc0(3),dersc(3))
5613 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5615 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5616 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
5617 dersc0(2),esclocbi,dersc02)
5618 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
5623 call splinthet(x(2),0.5d0*delta,ss,ssd)
5625 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5627 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5628 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5630 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5631 ! write (iout,*) escloci
5633 call enesc(x,escloci,dersc,ddummy,.false.)
5636 escloc=escloc+escloci
5637 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5639 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5641 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
5643 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5644 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5649 !-----------------------------------------------------------------------------
5650 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5653 ! implicit real*8 (a-h,o-z)
5654 ! include 'DIMENSIONS'
5655 ! include 'COMMON.GEO'
5656 ! include 'COMMON.LOCAL'
5657 ! include 'COMMON.IOUNITS'
5658 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5659 real(kind=8),dimension(3) :: x,z,dersc,ddersc
5660 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
5661 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
5662 real(kind=8) :: escloci
5665 integer :: j,iii,l,k !el,it,nlobit
5666 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
5667 !el time11,time12,time112
5668 ! write (iout,*) 'it=',it,' nlobit=',nlobit
5672 if (mixed) ddersc(j)=0.0d0
5676 ! Because of periodicity of the dependence of the SC energy in omega we have
5677 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5678 ! To avoid underflows, first compute & store the exponents.
5686 z(k)=x(k)-censc(k,j,it)
5691 Axk=Axk+gaussc(l,k,j,it)*z(l)
5697 expfac=expfac+Ax(k,j,iii)*z(k)
5705 ! As in the case of ebend, we want to avoid underflows in exponentiation and
5706 ! subsequent NaNs and INFs in energy calculation.
5707 ! Find the largest exponent
5711 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5715 !d print *,'it=',it,' emin=',emin
5717 ! Compute the contribution to SC energy and derivatives
5722 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5723 if(adexp.ne.adexp) adexp=1.0
5726 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5728 !d print *,'j=',j,' expfac=',expfac
5729 escloc_i=escloc_i+expfac
5731 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5735 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
5736 +gaussc(k,2,j,it))*expfac
5743 dersc(1)=dersc(1)/cos(theti)**2
5744 ddersc(1)=ddersc(1)/cos(theti)**2
5747 escloci=-(dlog(escloc_i)-emin)
5749 dersc(j)=dersc(j)/escloc_i
5753 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5757 end subroutine enesc
5758 !-----------------------------------------------------------------------------
5759 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5762 ! implicit real*8 (a-h,o-z)
5763 ! include 'DIMENSIONS'
5764 ! include 'COMMON.GEO'
5765 ! include 'COMMON.LOCAL'
5766 ! include 'COMMON.IOUNITS'
5767 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5768 real(kind=8),dimension(3) :: x,z,dersc
5769 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
5770 real(kind=8),dimension(nlobit) :: contr !(maxlob)
5771 real(kind=8) :: escloci,dersc12,emin
5774 integer :: j,k,l !el,it,nlobit
5775 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
5785 z(k)=x(k)-censc(k,j,it)
5791 Axk=Axk+gaussc(l,k,j,it)*z(l)
5797 expfac=expfac+Ax(k,j)*z(k)
5802 ! As in the case of ebend, we want to avoid underflows in exponentiation and
5803 ! subsequent NaNs and INFs in energy calculation.
5804 ! Find the largest exponent
5807 if (emin.gt.contr(j)) emin=contr(j)
5811 ! Compute the contribution to SC energy and derivatives
5815 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5816 escloc_i=escloc_i+expfac
5818 dersc(k)=dersc(k)+Ax(k,j)*expfac
5820 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
5821 +gaussc(1,2,j,it))*expfac
5825 dersc(1)=dersc(1)/cos(theti)**2
5826 dersc12=dersc12/cos(theti)**2
5827 escloci=-(dlog(escloc_i)-emin)
5829 dersc(j)=dersc(j)/escloc_i
5831 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5833 end subroutine enesc_bound
5835 !-----------------------------------------------------------------------------
5836 subroutine esc(escloc)
5837 ! Calculate the local energy of a side chain and its derivatives in the
5838 ! corresponding virtual-bond valence angles THETA and the spherical angles
5839 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
5840 ! added by Urszula Kozlowska. 07/11/2007
5843 ! implicit real*8 (a-h,o-z)
5844 ! include 'DIMENSIONS'
5845 ! include 'COMMON.GEO'
5846 ! include 'COMMON.LOCAL'
5847 ! include 'COMMON.VAR'
5848 ! include 'COMMON.SCROT'
5849 ! include 'COMMON.INTERACT'
5850 ! include 'COMMON.DERIV'
5851 ! include 'COMMON.CHAIN'
5852 ! include 'COMMON.IOUNITS'
5853 ! include 'COMMON.NAMES'
5854 ! include 'COMMON.FFIELD'
5855 ! include 'COMMON.CONTROL'
5856 ! include 'COMMON.VECTORS'
5857 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
5858 real(kind=8),dimension(65) :: x
5859 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
5860 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
5861 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
5862 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
5863 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
5865 integer :: i,j,k !el,it,nlobit
5866 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
5867 !el real(kind=8) :: time11,time12,time112,theti
5868 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5869 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
5870 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
5871 sumene1x,sumene2x,sumene3x,sumene4x,&
5872 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
5875 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
5876 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
5879 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
5883 do i=loc_start,loc_end
5884 if (itype(i).eq.ntyp1) cycle
5885 costtab(i+1) =dcos(theta(i+1))
5886 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5887 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5888 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5889 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5890 cosfac=dsqrt(cosfac2)
5891 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5892 sinfac=dsqrt(sinfac2)
5894 if (it.eq.10) goto 1
5896 ! Compute the axes of tghe local cartesian coordinates system; store in
5897 ! x_prime, y_prime and z_prime
5904 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5905 ! & dc_norm(3,i+nres)
5907 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5908 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5911 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5914 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
5915 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
5916 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
5917 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5918 ! & " xy",scalar(x_prime(1),y_prime(1)),
5919 ! & " xz",scalar(x_prime(1),z_prime(1)),
5920 ! & " yy",scalar(y_prime(1),y_prime(1)),
5921 ! & " yz",scalar(y_prime(1),z_prime(1)),
5922 ! & " zz",scalar(z_prime(1),z_prime(1))
5924 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5925 ! to local coordinate system. Store in xx, yy, zz.
5931 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5932 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5933 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5940 ! Compute the energy of the ith side cbain
5942 ! write (2,*) "xx",xx," yy",yy," zz",zz
5945 x(j) = sc_parmin(j,it)
5948 !c diagnostics - remove later
5950 yy1 = dsin(alph(2))*dcos(omeg(2))
5951 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5952 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
5953 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
5955 !," --- ", xx_w,yy_w,zz_w
5958 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
5959 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
5961 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
5962 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
5964 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
5965 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
5966 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
5967 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
5968 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
5970 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
5971 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
5972 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
5973 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
5974 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
5976 dsc_i = 0.743d0+x(61)
5978 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5979 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5980 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5981 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5982 s1=(1+x(63))/(0.1d0 + dscp1)
5983 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5984 s2=(1+x(65))/(0.1d0 + dscp2)
5985 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5986 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
5987 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5988 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5990 ! & dscp1,dscp2,sumene
5991 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5992 escloc = escloc + sumene
5993 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5998 ! This section to check the numerical derivatives of the energy of ith side
5999 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6000 ! #define DEBUG in the code to turn it on.
6002 write (2,*) "sumene =",sumene
6006 write (2,*) xx,yy,zz
6007 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6008 de_dxx_num=(sumenep-sumene)/aincr
6010 write (2,*) "xx+ sumene from enesc=",sumenep
6013 write (2,*) xx,yy,zz
6014 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6015 de_dyy_num=(sumenep-sumene)/aincr
6017 write (2,*) "yy+ sumene from enesc=",sumenep
6020 write (2,*) xx,yy,zz
6021 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6022 de_dzz_num=(sumenep-sumene)/aincr
6024 write (2,*) "zz+ sumene from enesc=",sumenep
6025 costsave=cost2tab(i+1)
6026 sintsave=sint2tab(i+1)
6027 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6028 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6029 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6030 de_dt_num=(sumenep-sumene)/aincr
6031 write (2,*) " t+ sumene from enesc=",sumenep
6032 cost2tab(i+1)=costsave
6033 sint2tab(i+1)=sintsave
6034 ! End of diagnostics section.
6037 ! Compute the gradient of esc
6039 ! zz=zz*dsign(1.0,dfloat(itype(i)))
6040 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6041 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6042 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6043 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6044 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6045 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6046 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6047 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6048 pom1=(sumene3*sint2tab(i+1)+sumene1) &
6049 *(pom_s1/dscp1+pom_s16*dscp1**4)
6050 pom2=(sumene4*cost2tab(i+1)+sumene2) &
6051 *(pom_s2/dscp2+pom_s26*dscp2**4)
6052 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6053 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
6054 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
6056 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6057 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
6058 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
6060 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
6061 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
6064 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6067 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6068 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
6069 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
6071 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6072 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
6073 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
6074 +x(59)*zz**2 +x(60)*xx*zz
6075 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
6076 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
6079 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6082 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
6083 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
6084 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
6085 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
6086 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
6087 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
6088 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
6089 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6091 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6094 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
6095 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
6096 +pom1*pom_dt1+pom2*pom_dt2
6098 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6102 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6103 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6104 cosfac2xx=cosfac2*xx
6105 sinfac2yy=sinfac2*yy
6107 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
6109 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
6111 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6112 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6113 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6114 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6115 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6116 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6117 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6118 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6119 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6120 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6124 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
6125 *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6126 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
6127 *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6130 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6131 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6132 dZZ_XYZ(k)=vbld_inv(i+nres)* &
6133 (z_prime(k)-zz*dC_norm(k,i+nres))
6135 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6136 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6140 dXX_Ctab(k,i)=dXX_Ci(k)
6141 dXX_C1tab(k,i)=dXX_Ci1(k)
6142 dYY_Ctab(k,i)=dYY_Ci(k)
6143 dYY_C1tab(k,i)=dYY_Ci1(k)
6144 dZZ_Ctab(k,i)=dZZ_Ci(k)
6145 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6146 dXX_XYZtab(k,i)=dXX_XYZ(k)
6147 dYY_XYZtab(k,i)=dYY_XYZ(k)
6148 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6152 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6153 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6154 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6155 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
6156 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6158 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6159 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6160 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
6161 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6162 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
6163 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6164 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
6165 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6167 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6168 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6170 ! to check gradient call subroutine check_grad
6176 !-----------------------------------------------------------------------------
6177 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
6179 real(kind=8),dimension(65) :: x
6180 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
6181 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6183 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6184 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6186 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6187 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6189 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6190 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6191 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6192 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6193 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6195 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6196 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6197 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6198 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6199 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6201 dsc_i = 0.743d0+x(61)
6203 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6204 *(xx*cost2+yy*sint2))
6205 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6206 *(xx*cost2-yy*sint2))
6207 s1=(1+x(63))/(0.1d0 + dscp1)
6208 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6209 s2=(1+x(65))/(0.1d0 + dscp2)
6210 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6211 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
6212 + (sumene4*cost2 +sumene2)*(s2+s2_6)
6217 !-----------------------------------------------------------------------------
6218 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6220 ! This procedure calculates two-body contact function g(rij) and its derivative:
6223 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6226 ! where x=(rij-r0ij)/delta
6228 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6231 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
6232 real(kind=8) :: x,x2,x4,delta
6236 if (x.lt.-1.0D0) then
6239 else if (x.le.1.0D0) then
6242 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6243 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6249 end subroutine gcont
6250 !-----------------------------------------------------------------------------
6251 subroutine splinthet(theti,delta,ss,ssder)
6252 ! implicit real*8 (a-h,o-z)
6253 ! include 'DIMENSIONS'
6254 ! include 'COMMON.VAR'
6255 ! include 'COMMON.GEO'
6256 real(kind=8) :: theti,delta,ss,ssder
6257 real(kind=8) :: thetup,thetlow
6260 if (theti.gt.pipol) then
6261 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6263 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6267 end subroutine splinthet
6268 !-----------------------------------------------------------------------------
6269 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6271 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
6272 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6273 a1=fprim0*delta/(f1-f0)
6279 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6280 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6282 end subroutine spline1
6283 !-----------------------------------------------------------------------------
6284 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6286 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
6287 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6292 a2=3*(f1x-f0x)-2*fprim0x*delta
6293 a3=fprim0x*delta-2*(f1x-f0x)
6294 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6296 end subroutine spline2
6297 !-----------------------------------------------------------------------------
6299 !-----------------------------------------------------------------------------
6300 subroutine etor(etors,edihcnstr)
6301 ! implicit real*8 (a-h,o-z)
6302 ! include 'DIMENSIONS'
6303 ! include 'COMMON.VAR'
6304 ! include 'COMMON.GEO'
6305 ! include 'COMMON.LOCAL'
6306 ! include 'COMMON.TORSION'
6307 ! include 'COMMON.INTERACT'
6308 ! include 'COMMON.DERIV'
6309 ! include 'COMMON.CHAIN'
6310 ! include 'COMMON.NAMES'
6311 ! include 'COMMON.IOUNITS'
6312 ! include 'COMMON.FFIELD'
6313 ! include 'COMMON.TORCNSTR'
6314 ! include 'COMMON.CONTROL'
6315 real(kind=8) :: etors,edihcnstr
6319 real(kind=8) :: phii,fac,etors_ii
6321 ! Set lprn=.true. for debugging
6325 do i=iphi_start,iphi_end
6327 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 &
6328 .or. itype(i).eq.ntyp1) cycle
6329 itori=itortyp(itype(i-2))
6330 itori1=itortyp(itype(i-1))
6333 ! Proline-Proline pair is a special case...
6334 if (itori.eq.3 .and. itori1.eq.3) then
6335 if (phii.gt.-dwapi3) then
6337 fac=1.0D0/(1.0D0-cosphi)
6338 etorsi=v1(1,3,3)*fac
6339 etorsi=etorsi+etorsi
6340 etors=etors+etorsi-v1(1,3,3)
6341 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6342 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6345 v1ij=v1(j+1,itori,itori1)
6346 v2ij=v2(j+1,itori,itori1)
6349 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6350 if (energy_dec) etors_ii=etors_ii+ &
6351 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6352 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6356 v1ij=v1(j,itori,itori1)
6357 v2ij=v2(j,itori,itori1)
6360 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6361 if (energy_dec) etors_ii=etors_ii+ &
6362 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6363 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6366 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6369 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6370 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
6371 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6372 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6373 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6375 ! 6/20/98 - dihedral angle constraints
6378 itori=idih_constr(i)
6381 if (difi.gt.drange(i)) then
6383 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6384 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6385 else if (difi.lt.-drange(i)) then
6387 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6388 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6390 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6391 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6393 ! write (iout,*) 'edihcnstr',edihcnstr
6396 !-----------------------------------------------------------------------------
6397 subroutine etor_d(etors_d)
6398 real(kind=8) :: etors_d
6401 end subroutine etor_d
6403 !-----------------------------------------------------------------------------
6404 subroutine etor(etors,edihcnstr)
6405 ! implicit real*8 (a-h,o-z)
6406 ! include 'DIMENSIONS'
6407 ! include 'COMMON.VAR'
6408 ! include 'COMMON.GEO'
6409 ! include 'COMMON.LOCAL'
6410 ! include 'COMMON.TORSION'
6411 ! include 'COMMON.INTERACT'
6412 ! include 'COMMON.DERIV'
6413 ! include 'COMMON.CHAIN'
6414 ! include 'COMMON.NAMES'
6415 ! include 'COMMON.IOUNITS'
6416 ! include 'COMMON.FFIELD'
6417 ! include 'COMMON.TORCNSTR'
6418 ! include 'COMMON.CONTROL'
6419 real(kind=8) :: etors,edihcnstr
6422 integer :: i,j,iblock,itori,itori1
6423 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
6424 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
6425 ! Set lprn=.true. for debugging
6429 do i=iphi_start,iphi_end
6430 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
6431 .or. itype(i-3).eq.ntyp1 &
6432 .or. itype(i).eq.ntyp1) cycle
6434 if (iabs(itype(i)).eq.20) then
6439 itori=itortyp(itype(i-2))
6440 itori1=itortyp(itype(i-1))
6443 ! Regular cosine and sine terms
6444 do j=1,nterm(itori,itori1,iblock)
6445 v1ij=v1(j,itori,itori1,iblock)
6446 v2ij=v2(j,itori,itori1,iblock)
6449 etors=etors+v1ij*cosphi+v2ij*sinphi
6450 if (energy_dec) etors_ii=etors_ii+ &
6451 v1ij*cosphi+v2ij*sinphi
6452 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6456 ! E = SUM ----------------------------------- - v1
6457 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6459 cosphi=dcos(0.5d0*phii)
6460 sinphi=dsin(0.5d0*phii)
6461 do j=1,nlor(itori,itori1,iblock)
6462 vl1ij=vlor1(j,itori,itori1)
6463 vl2ij=vlor2(j,itori,itori1)
6464 vl3ij=vlor3(j,itori,itori1)
6465 pom=vl2ij*cosphi+vl3ij*sinphi
6466 pom1=1.0d0/(pom*pom+1.0d0)
6467 etors=etors+vl1ij*pom1
6468 if (energy_dec) etors_ii=etors_ii+ &
6471 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6473 ! Subtract the constant term
6474 etors=etors-v0(itori,itori1,iblock)
6475 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6476 'etor',i,etors_ii-v0(itori,itori1,iblock)
6478 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6479 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
6480 (v1(j,itori,itori1,iblock),j=1,6),&
6481 (v2(j,itori,itori1,iblock),j=1,6)
6482 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6483 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6485 ! 6/20/98 - dihedral angle constraints
6487 ! do i=1,ndih_constr
6488 do i=idihconstr_start,idihconstr_end
6489 itori=idih_constr(i)
6491 difi=pinorm(phii-phi0(i))
6492 if (difi.gt.drange(i)) then
6494 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6495 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6496 else if (difi.lt.-drange(i)) then
6498 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6499 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6503 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6504 !d & rad2deg*phi0(i), rad2deg*drange(i),
6505 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6507 !d write (iout,*) 'edihcnstr',edihcnstr
6510 !-----------------------------------------------------------------------------
6511 subroutine etor_d(etors_d)
6512 ! 6/23/01 Compute double torsional energy
6513 ! implicit real*8 (a-h,o-z)
6514 ! include 'DIMENSIONS'
6515 ! include 'COMMON.VAR'
6516 ! include 'COMMON.GEO'
6517 ! include 'COMMON.LOCAL'
6518 ! include 'COMMON.TORSION'
6519 ! include 'COMMON.INTERACT'
6520 ! include 'COMMON.DERIV'
6521 ! include 'COMMON.CHAIN'
6522 ! include 'COMMON.NAMES'
6523 ! include 'COMMON.IOUNITS'
6524 ! include 'COMMON.FFIELD'
6525 ! include 'COMMON.TORCNSTR'
6526 real(kind=8) :: etors_d,etors_d_ii
6529 integer :: i,j,k,l,itori,itori1,itori2,iblock
6530 real(kind=8) :: phii,phii1,gloci1,gloci2,&
6531 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
6532 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
6533 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
6534 ! Set lprn=.true. for debugging
6538 ! write(iout,*) "a tu??"
6539 do i=iphid_start,iphid_end
6541 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
6542 .or. itype(i-3).eq.ntyp1 &
6543 .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
6544 itori=itortyp(itype(i-2))
6545 itori1=itortyp(itype(i-1))
6546 itori2=itortyp(itype(i))
6552 if (iabs(itype(i+1)).eq.20) iblock=2
6554 ! Regular cosine and sine terms
6555 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6556 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6557 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6558 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6559 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6560 cosphi1=dcos(j*phii)
6561 sinphi1=dsin(j*phii)
6562 cosphi2=dcos(j*phii1)
6563 sinphi2=dsin(j*phii1)
6564 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
6565 v2cij*cosphi2+v2sij*sinphi2
6566 if (energy_dec) etors_d_ii=etors_d_ii+ &
6567 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
6568 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6569 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6571 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6573 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6574 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6575 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6576 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6577 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6578 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6579 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6580 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6581 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6582 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6583 if (energy_dec) etors_d_ii=etors_d_ii+ &
6584 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6585 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6586 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
6587 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6588 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
6589 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6592 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6593 'etor_d',i,etors_d_ii
6594 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6595 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6598 end subroutine etor_d
6600 !-----------------------------------------------------------------------------
6601 subroutine eback_sc_corr(esccor)
6602 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
6603 ! conformational states; temporarily implemented as differences
6604 ! between UNRES torsional potentials (dependent on three types of
6605 ! residues) and the torsional potentials dependent on all 20 types
6606 ! of residues computed from AM1 energy surfaces of terminally-blocked
6607 ! amino-acid residues.
6608 ! implicit real*8 (a-h,o-z)
6609 ! include 'DIMENSIONS'
6610 ! include 'COMMON.VAR'
6611 ! include 'COMMON.GEO'
6612 ! include 'COMMON.LOCAL'
6613 ! include 'COMMON.TORSION'
6614 ! include 'COMMON.SCCOR'
6615 ! include 'COMMON.INTERACT'
6616 ! include 'COMMON.DERIV'
6617 ! include 'COMMON.CHAIN'
6618 ! include 'COMMON.NAMES'
6619 ! include 'COMMON.IOUNITS'
6620 ! include 'COMMON.FFIELD'
6621 ! include 'COMMON.CONTROL'
6622 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
6625 integer :: i,interty,j,isccori,isccori1,intertyp
6626 ! Set lprn=.true. for debugging
6629 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6631 do i=itau_start,itau_end
6632 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6634 isccori=isccortyp(itype(i-2))
6635 isccori1=isccortyp(itype(i-1))
6637 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6639 do intertyp=1,3 !intertyp
6641 !c Added 09 May 2012 (Adasko)
6642 !c Intertyp means interaction type of backbone mainchain correlation:
6643 ! 1 = SC...Ca...Ca...Ca
6644 ! 2 = Ca...Ca...Ca...SC
6645 ! 3 = SC...Ca...Ca...SCi
6647 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. &
6648 (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or. &
6649 (itype(i-1).eq.ntyp1))) &
6650 .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) &
6651 .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1) &
6652 .or.(itype(i).eq.ntyp1))) &
6653 .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. &
6654 (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. &
6655 (itype(i-3).eq.ntyp1)))) cycle
6656 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6657 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1)) &
6659 do j=1,nterm_sccor(isccori,isccori1)
6660 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6661 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6662 cosphi=dcos(j*tauangle(intertyp,i))
6663 sinphi=dsin(j*tauangle(intertyp,i))
6664 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
6665 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6666 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6668 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
6669 'esccor',i,intertyp,esccor_ii
6670 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6671 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6673 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6674 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,&
6675 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
6676 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6677 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6682 end subroutine eback_sc_corr
6683 !-----------------------------------------------------------------------------
6684 subroutine multibody(ecorr)
6685 ! This subroutine calculates multi-body contributions to energy following
6686 ! the idea of Skolnick et al. If side chains I and J make a contact and
6687 ! at the same time side chains I+1 and J+1 make a contact, an extra
6688 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6689 ! implicit real*8 (a-h,o-z)
6690 ! include 'DIMENSIONS'
6691 ! include 'COMMON.IOUNITS'
6692 ! include 'COMMON.DERIV'
6693 ! include 'COMMON.INTERACT'
6694 ! include 'COMMON.CONTACTS'
6695 real(kind=8),dimension(3) :: gx,gx1
6697 real(kind=8) :: ecorr
6698 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
6699 ! Set lprn=.true. for debugging
6703 write (iout,'(a)') 'Contact function values:'
6705 write (iout,'(i2,20(1x,i2,f10.5))') &
6706 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6711 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6712 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6724 num_conti=num_cont(i)
6725 num_conti1=num_cont(i1)
6730 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6731 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6732 !d & ' ishift=',ishift
6733 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6734 ! The system gains extra energy.
6735 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6736 endif ! j1==j+-ishift
6744 end subroutine multibody
6745 !-----------------------------------------------------------------------------
6746 real(kind=8) function esccorr(i,j,k,l,jj,kk)
6747 ! implicit real*8 (a-h,o-z)
6748 ! include 'DIMENSIONS'
6749 ! include 'COMMON.IOUNITS'
6750 ! include 'COMMON.DERIV'
6751 ! include 'COMMON.INTERACT'
6752 ! include 'COMMON.CONTACTS'
6753 real(kind=8),dimension(3) :: gx,gx1
6755 integer :: i,j,k,l,jj,kk,m,ll
6756 real(kind=8) :: eij,ekl
6760 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6761 ! Calculate the multi-body contribution to energy.
6762 ! Calculate multi-body contributions to the gradient.
6763 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6764 !d & k,l,(gacont(m,kk,k),m=1,3)
6766 gx(m) =ekl*gacont(m,jj,i)
6767 gx1(m)=eij*gacont(m,kk,k)
6768 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6769 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6770 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6771 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6775 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6780 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6785 end function esccorr
6786 !-----------------------------------------------------------------------------
6787 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6788 ! This subroutine calculates multi-body contributions to hydrogen-bonding
6789 ! implicit real*8 (a-h,o-z)
6790 ! include 'DIMENSIONS'
6791 ! include 'COMMON.IOUNITS'
6794 ! integer :: maxconts !max_cont=maxconts =nres/4
6795 integer,parameter :: max_dim=26
6796 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6797 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6798 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
6799 !el common /przechowalnia/ zapas
6800 integer :: status(MPI_STATUS_SIZE)
6801 integer,dimension((nres/4)*2) :: req !maxconts*2
6802 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
6804 ! include 'COMMON.SETUP'
6805 ! include 'COMMON.FFIELD'
6806 ! include 'COMMON.DERIV'
6807 ! include 'COMMON.INTERACT'
6808 ! include 'COMMON.CONTACTS'
6809 ! include 'COMMON.CONTROL'
6810 ! include 'COMMON.LOCAL'
6811 real(kind=8),dimension(3) :: gx,gx1
6812 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
6813 logical :: lprn,ldone
6815 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
6816 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
6818 ! Set lprn=.true. for debugging
6822 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
6825 if (nfgtasks.le.1) goto 30
6827 write (iout,'(a)') 'Contact function values before RECEIVE:'
6829 write (iout,'(2i3,50(1x,i2,f5.2))') &
6830 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6835 do i=1,ntask_cont_from
6838 do i=1,ntask_cont_to
6841 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6843 ! Make the list of contacts to send to send to other procesors
6844 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6846 do i=iturn3_start,iturn3_end
6847 ! write (iout,*) "make contact list turn3",i," num_cont",
6849 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6851 do i=iturn4_start,iturn4_end
6852 ! write (iout,*) "make contact list turn4",i," num_cont",
6854 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6858 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
6860 do j=1,num_cont_hb(i)
6863 iproc=iint_sent_local(k,jjc,ii)
6864 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6865 if (iproc.gt.0) then
6866 ncont_sent(iproc)=ncont_sent(iproc)+1
6867 nn=ncont_sent(iproc)
6869 zapas(2,nn,iproc)=jjc
6870 zapas(3,nn,iproc)=facont_hb(j,i)
6871 zapas(4,nn,iproc)=ees0p(j,i)
6872 zapas(5,nn,iproc)=ees0m(j,i)
6873 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6874 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6875 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6876 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6877 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6878 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6879 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6880 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6881 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6882 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6883 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6884 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6885 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6886 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6887 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6888 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6889 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6890 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6891 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6892 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6893 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6900 "Numbers of contacts to be sent to other processors",&
6901 (ncont_sent(i),i=1,ntask_cont_to)
6902 write (iout,*) "Contacts sent"
6903 do ii=1,ntask_cont_to
6905 iproc=itask_cont_to(ii)
6906 write (iout,*) nn," contacts to processor",iproc,&
6907 " of CONT_TO_COMM group"
6909 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6917 CorrelID1=nfgtasks+fg_rank+1
6919 ! Receive the numbers of needed contacts from other processors
6920 do ii=1,ntask_cont_from
6921 iproc=itask_cont_from(ii)
6923 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
6924 FG_COMM,req(ireq),IERR)
6926 ! write (iout,*) "IRECV ended"
6928 ! Send the number of contacts needed by other processors
6929 do ii=1,ntask_cont_to
6930 iproc=itask_cont_to(ii)
6932 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
6933 FG_COMM,req(ireq),IERR)
6935 ! write (iout,*) "ISEND ended"
6936 ! write (iout,*) "number of requests (nn)",ireq
6939 call MPI_Waitall(ireq,req,status_array,ierr)
6941 ! & "Numbers of contacts to be received from other processors",
6942 ! & (ncont_recv(i),i=1,ntask_cont_from)
6946 do ii=1,ntask_cont_from
6947 iproc=itask_cont_from(ii)
6949 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
6950 ! & " of CONT_TO_COMM group"
6954 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
6955 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6956 ! write (iout,*) "ireq,req",ireq,req(ireq)
6959 ! Send the contacts to processors that need them
6960 do ii=1,ntask_cont_to
6961 iproc=itask_cont_to(ii)
6963 ! write (iout,*) nn," contacts to processor",iproc,
6964 ! & " of CONT_TO_COMM group"
6967 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
6968 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6969 ! write (iout,*) "ireq,req",ireq,req(ireq)
6971 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6975 ! write (iout,*) "number of requests (contacts)",ireq
6976 ! write (iout,*) "req",(req(i),i=1,4)
6979 call MPI_Waitall(ireq,req,status_array,ierr)
6980 do iii=1,ntask_cont_from
6981 iproc=itask_cont_from(iii)
6984 write (iout,*) "Received",nn," contacts from processor",iproc,&
6985 " of CONT_FROM_COMM group"
6988 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6993 ii=zapas_recv(1,i,iii)
6994 ! Flag the received contacts to prevent double-counting
6995 jj=-zapas_recv(2,i,iii)
6996 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6998 nnn=num_cont_hb(ii)+1
7001 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7002 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7003 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7004 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7005 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7006 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7007 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7008 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7009 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7010 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7011 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7012 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7013 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7014 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7015 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7016 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7017 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7018 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7019 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7020 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7021 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7022 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7023 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7024 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7029 write (iout,'(a)') 'Contact function values after receive:'
7031 write (iout,'(2i3,50(1x,i3,f5.2))') &
7032 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7040 write (iout,'(a)') 'Contact function values:'
7042 write (iout,'(2i3,50(1x,i3,f5.2))') &
7043 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7049 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7050 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7051 ! Remove the loop below after debugging !!!
7058 ! Calculate the local-electrostatic correlation terms
7059 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7061 num_conti=num_cont_hb(i)
7062 num_conti1=num_cont_hb(i+1)
7069 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
7070 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
7071 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7072 .or. j.lt.0 .and. j1.gt.0) .and. &
7073 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7074 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7075 ! The system gains extra energy.
7076 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7077 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
7078 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7080 else if (j1.eq.j) then
7081 ! Contacts I-J and I-(J+1) occur simultaneously.
7082 ! The system loses extra energy.
7083 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7088 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7089 ! & ' jj=',jj,' kk=',kk
7091 ! Contacts I-J and (I+1)-J occur simultaneously.
7092 ! The system loses extra energy.
7093 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7099 end subroutine multibody_hb
7100 !-----------------------------------------------------------------------------
7101 subroutine add_hb_contact(ii,jj,itask)
7102 ! implicit real*8 (a-h,o-z)
7103 ! include "DIMENSIONS"
7104 ! include "COMMON.IOUNITS"
7105 ! include "COMMON.CONTACTS"
7106 ! integer,parameter :: maxconts=nres/4
7107 integer,parameter :: max_dim=26
7108 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7109 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7110 ! common /przechowalnia/ zapas
7111 integer :: i,j,ii,jj,iproc,nn,jjc
7112 integer,dimension(4) :: itask
7113 ! write (iout,*) "itask",itask
7116 if (iproc.gt.0) then
7117 do j=1,num_cont_hb(ii)
7119 ! write (iout,*) "i",ii," j",jj," jjc",jjc
7121 ncont_sent(iproc)=ncont_sent(iproc)+1
7122 nn=ncont_sent(iproc)
7123 zapas(1,nn,iproc)=ii
7124 zapas(2,nn,iproc)=jjc
7125 zapas(3,nn,iproc)=facont_hb(j,ii)
7126 zapas(4,nn,iproc)=ees0p(j,ii)
7127 zapas(5,nn,iproc)=ees0m(j,ii)
7128 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7129 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7130 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7131 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7132 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7133 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7134 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7135 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7136 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7137 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7138 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7139 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7140 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7141 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7142 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7143 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7144 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7145 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7146 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7147 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7148 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7155 end subroutine add_hb_contact
7156 !-----------------------------------------------------------------------------
7157 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
7158 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7159 ! implicit real*8 (a-h,o-z)
7160 ! include 'DIMENSIONS'
7161 ! include 'COMMON.IOUNITS'
7162 integer,parameter :: max_dim=70
7165 ! integer :: maxconts !max_cont=maxconts=nres/4
7166 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7167 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7168 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7169 ! common /przechowalnia/ zapas
7170 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
7171 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
7174 ! include 'COMMON.SETUP'
7175 ! include 'COMMON.FFIELD'
7176 ! include 'COMMON.DERIV'
7177 ! include 'COMMON.LOCAL'
7178 ! include 'COMMON.INTERACT'
7179 ! include 'COMMON.CONTACTS'
7180 ! include 'COMMON.CHAIN'
7181 ! include 'COMMON.CONTROL'
7182 real(kind=8),dimension(3) :: gx,gx1
7183 integer,dimension(nres) :: num_cont_hb_old
7184 logical :: lprn,ldone
7185 !EL double precision eello4,eello5,eelo6,eello_turn6
7186 !EL external eello4,eello5,eello6,eello_turn6
7188 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
7189 j1,jp1,i1,num_conti1
7190 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
7191 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
7193 ! Set lprn=.true. for debugging
7198 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7200 num_cont_hb_old(i)=num_cont_hb(i)
7204 if (nfgtasks.le.1) goto 30
7206 write (iout,'(a)') 'Contact function values before RECEIVE:'
7208 write (iout,'(2i3,50(1x,i2,f5.2))') &
7209 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7214 do i=1,ntask_cont_from
7217 do i=1,ntask_cont_to
7220 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7222 ! Make the list of contacts to send to send to other procesors
7223 do i=iturn3_start,iturn3_end
7224 ! write (iout,*) "make contact list turn3",i," num_cont",
7226 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7228 do i=iturn4_start,iturn4_end
7229 ! write (iout,*) "make contact list turn4",i," num_cont",
7231 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7235 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7237 do j=1,num_cont_hb(i)
7240 iproc=iint_sent_local(k,jjc,ii)
7241 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7242 if (iproc.ne.0) then
7243 ncont_sent(iproc)=ncont_sent(iproc)+1
7244 nn=ncont_sent(iproc)
7246 zapas(2,nn,iproc)=jjc
7247 zapas(3,nn,iproc)=d_cont(j,i)
7251 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7256 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7264 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7275 "Numbers of contacts to be sent to other processors",&
7276 (ncont_sent(i),i=1,ntask_cont_to)
7277 write (iout,*) "Contacts sent"
7278 do ii=1,ntask_cont_to
7280 iproc=itask_cont_to(ii)
7281 write (iout,*) nn," contacts to processor",iproc,&
7282 " of CONT_TO_COMM group"
7284 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7292 CorrelID1=nfgtasks+fg_rank+1
7294 ! Receive the numbers of needed contacts from other processors
7295 do ii=1,ntask_cont_from
7296 iproc=itask_cont_from(ii)
7298 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7299 FG_COMM,req(ireq),IERR)
7301 ! write (iout,*) "IRECV ended"
7303 ! Send the number of contacts needed by other processors
7304 do ii=1,ntask_cont_to
7305 iproc=itask_cont_to(ii)
7307 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7308 FG_COMM,req(ireq),IERR)
7310 ! write (iout,*) "ISEND ended"
7311 ! write (iout,*) "number of requests (nn)",ireq
7314 call MPI_Waitall(ireq,req,status_array,ierr)
7316 ! & "Numbers of contacts to be received from other processors",
7317 ! & (ncont_recv(i),i=1,ntask_cont_from)
7321 do ii=1,ntask_cont_from
7322 iproc=itask_cont_from(ii)
7324 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7325 ! & " of CONT_TO_COMM group"
7329 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7330 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7331 ! write (iout,*) "ireq,req",ireq,req(ireq)
7334 ! Send the contacts to processors that need them
7335 do ii=1,ntask_cont_to
7336 iproc=itask_cont_to(ii)
7338 ! write (iout,*) nn," contacts to processor",iproc,
7339 ! & " of CONT_TO_COMM group"
7342 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7343 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7344 ! write (iout,*) "ireq,req",ireq,req(ireq)
7346 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7350 ! write (iout,*) "number of requests (contacts)",ireq
7351 ! write (iout,*) "req",(req(i),i=1,4)
7354 call MPI_Waitall(ireq,req,status_array,ierr)
7355 do iii=1,ntask_cont_from
7356 iproc=itask_cont_from(iii)
7359 write (iout,*) "Received",nn," contacts from processor",iproc,&
7360 " of CONT_FROM_COMM group"
7363 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7368 ii=zapas_recv(1,i,iii)
7369 ! Flag the received contacts to prevent double-counting
7370 jj=-zapas_recv(2,i,iii)
7371 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7373 nnn=num_cont_hb(ii)+1
7376 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7380 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7385 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7393 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7402 write (iout,'(a)') 'Contact function values after receive:'
7404 write (iout,'(2i3,50(1x,i3,5f6.3))') &
7405 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7406 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7413 write (iout,'(a)') 'Contact function values:'
7415 write (iout,'(2i3,50(1x,i2,5f6.3))') &
7416 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7417 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7424 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7425 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7426 ! Remove the loop below after debugging !!!
7433 ! Calculate the dipole-dipole interaction energies
7434 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7435 do i=iatel_s,iatel_e+1
7436 num_conti=num_cont_hb(i)
7445 ! Calculate the local-electrostatic correlation terms
7446 ! write (iout,*) "gradcorr5 in eello5 before loop"
7448 ! write (iout,'(i5,3f10.5)')
7449 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7451 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7452 ! write (iout,*) "corr loop i",i
7454 num_conti=num_cont_hb(i)
7455 num_conti1=num_cont_hb(i+1)
7462 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7463 ! & ' jj=',jj,' kk=',kk
7464 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
7465 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7466 .or. j.lt.0 .and. j1.gt.0) .and. &
7467 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7468 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7469 ! The system gains extra energy.
7471 sqd1=dsqrt(d_cont(jj,i))
7472 sqd2=dsqrt(d_cont(kk,i1))
7473 sred_geom = sqd1*sqd2
7474 IF (sred_geom.lt.cutoff_corr) THEN
7475 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
7477 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7478 !d & ' jj=',jj,' kk=',kk
7479 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7480 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7482 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7483 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7486 !d write (iout,*) 'sred_geom=',sred_geom,
7487 !d & ' ekont=',ekont,' fprim=',fprimcont,
7488 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7489 !d write (iout,*) "g_contij",g_contij
7490 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7491 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7492 call calc_eello(i,jp,i+1,jp1,jj,kk)
7493 if (wcorr4.gt.0.0d0) &
7494 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7495 if (energy_dec.and.wcorr4.gt.0.0d0) &
7496 write (iout,'(a6,4i5,0pf7.3)') &
7497 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7498 ! write (iout,*) "gradcorr5 before eello5"
7500 ! write (iout,'(i5,3f10.5)')
7501 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7503 if (wcorr5.gt.0.0d0) &
7504 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7505 ! write (iout,*) "gradcorr5 after eello5"
7507 ! write (iout,'(i5,3f10.5)')
7508 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7510 if (energy_dec.and.wcorr5.gt.0.0d0) &
7511 write (iout,'(a6,4i5,0pf7.3)') &
7512 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7513 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7514 !d write(2,*)'ijkl',i,jp,i+1,jp1
7515 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
7516 .or. wturn6.eq.0.0d0))then
7517 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7518 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7519 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7520 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7521 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7522 !d & 'ecorr6=',ecorr6
7523 !d write (iout,'(4e15.5)') sred_geom,
7524 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7525 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7526 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7527 else if (wturn6.gt.0.0d0 &
7528 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7529 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7530 eturn6=eturn6+eello_turn6(i,jj,kk)
7531 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7532 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7533 !d write (2,*) 'multibody_eello:eturn6',eturn6
7542 num_cont_hb(i)=num_cont_hb_old(i)
7544 ! write (iout,*) "gradcorr5 in eello5"
7546 ! write (iout,'(i5,3f10.5)')
7547 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7550 end subroutine multibody_eello
7551 !-----------------------------------------------------------------------------
7552 subroutine add_hb_contact_eello(ii,jj,itask)
7553 ! implicit real*8 (a-h,o-z)
7554 ! include "DIMENSIONS"
7555 ! include "COMMON.IOUNITS"
7556 ! include "COMMON.CONTACTS"
7557 ! integer,parameter :: maxconts=nres/4
7558 integer,parameter :: max_dim=70
7559 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7560 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7561 ! common /przechowalnia/ zapas
7563 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
7564 integer,dimension(4) ::itask
7565 ! write (iout,*) "itask",itask
7568 if (iproc.gt.0) then
7569 do j=1,num_cont_hb(ii)
7571 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7573 ncont_sent(iproc)=ncont_sent(iproc)+1
7574 nn=ncont_sent(iproc)
7575 zapas(1,nn,iproc)=ii
7576 zapas(2,nn,iproc)=jjc
7577 zapas(3,nn,iproc)=d_cont(j,ii)
7581 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7586 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7594 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7605 end subroutine add_hb_contact_eello
7606 !-----------------------------------------------------------------------------
7607 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7608 ! implicit real*8 (a-h,o-z)
7609 ! include 'DIMENSIONS'
7610 ! include 'COMMON.IOUNITS'
7611 ! include 'COMMON.DERIV'
7612 ! include 'COMMON.INTERACT'
7613 ! include 'COMMON.CONTACTS'
7614 real(kind=8),dimension(3) :: gx,gx1
7617 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
7618 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
7619 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
7620 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
7631 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7632 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7633 ! Following 4 lines for diagnostics.
7638 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7639 ! & 'Contacts ',i,j,
7640 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7641 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7643 ! Calculate the multi-body contribution to energy.
7644 ! ecorr=ecorr+ekont*ees
7645 ! Calculate multi-body contributions to the gradient.
7646 coeffpees0pij=coeffp*ees0pij
7647 coeffmees0mij=coeffm*ees0mij
7648 coeffpees0pkl=coeffp*ees0pkl
7649 coeffmees0mkl=coeffm*ees0mkl
7651 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7652 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
7653 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
7654 coeffmees0mkl*gacontm_hb1(ll,jj,i))
7655 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
7656 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
7657 coeffmees0mkl*gacontm_hb2(ll,jj,i))
7658 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7659 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
7660 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
7661 coeffmees0mij*gacontm_hb1(ll,kk,k))
7662 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
7663 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
7664 coeffmees0mij*gacontm_hb2(ll,kk,k))
7665 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
7666 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
7667 coeffmees0mkl*gacontm_hb3(ll,jj,i))
7668 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7669 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7670 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
7671 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
7672 coeffmees0mij*gacontm_hb3(ll,kk,k))
7673 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7674 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7675 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7680 !grad gradcorr(ll,m)=gradcorr(ll,m)+
7681 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
7682 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7683 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7688 !grad gradcorr(ll,m)=gradcorr(ll,m)+
7689 !grad & ees*eij*gacont_hbr(ll,kk,k)-
7690 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7691 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7694 ! write (iout,*) "ehbcorr",ekont*ees
7696 if (shield_mode.gt.0) then
7699 !C print *,i,j,fac_shield(i),fac_shield(j),
7700 !C &fac_shield(k),fac_shield(l)
7701 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
7702 (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
7703 do ilist=1,ishield_list(i)
7704 iresshield=shield_list(ilist,i)
7706 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
7707 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7709 +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
7710 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7714 do ilist=1,ishield_list(j)
7715 iresshield=shield_list(ilist,j)
7717 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
7718 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7720 +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
7721 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7726 do ilist=1,ishield_list(k)
7727 iresshield=shield_list(ilist,k)
7729 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
7730 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7732 +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
7733 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7737 do ilist=1,ishield_list(l)
7738 iresshield=shield_list(ilist,l)
7740 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
7741 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7743 +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
7744 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7749 gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
7750 grad_shield(m,i)*ehbcorr/fac_shield(i)
7751 gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
7752 grad_shield(m,j)*ehbcorr/fac_shield(j)
7753 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
7754 grad_shield(m,i)*ehbcorr/fac_shield(i)
7755 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
7756 grad_shield(m,j)*ehbcorr/fac_shield(j)
7758 gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
7759 grad_shield(m,k)*ehbcorr/fac_shield(k)
7760 gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
7761 grad_shield(m,l)*ehbcorr/fac_shield(l)
7762 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
7763 grad_shield(m,k)*ehbcorr/fac_shield(k)
7764 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
7765 grad_shield(m,l)*ehbcorr/fac_shield(l)
7771 end function ehbcorr
7773 !-----------------------------------------------------------------------------
7774 subroutine dipole(i,j,jj)
7775 ! implicit real*8 (a-h,o-z)
7776 ! include 'DIMENSIONS'
7777 ! include 'COMMON.IOUNITS'
7778 ! include 'COMMON.CHAIN'
7779 ! include 'COMMON.FFIELD'
7780 ! include 'COMMON.DERIV'
7781 ! include 'COMMON.INTERACT'
7782 ! include 'COMMON.CONTACTS'
7783 ! include 'COMMON.TORSION'
7784 ! include 'COMMON.VAR'
7785 ! include 'COMMON.GEO'
7786 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
7787 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
7788 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
7790 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
7791 allocate(dipderx(3,5,4,maxconts,nres))
7794 iti1 = itortyp(itype(i+1))
7795 if (j.lt.nres-1) then
7796 itj1 = itortyp(itype(j+1))
7801 dipi(iii,1)=Ub2(iii,i)
7802 dipderi(iii)=Ub2der(iii,i)
7803 dipi(iii,2)=b1(iii,iti1)
7804 dipj(iii,1)=Ub2(iii,j)
7805 dipderj(iii)=Ub2der(iii,j)
7806 dipj(iii,2)=b1(iii,itj1)
7810 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7813 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7820 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
7824 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7829 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7830 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7832 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7834 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7836 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7839 end subroutine dipole
7841 !-----------------------------------------------------------------------------
7842 subroutine calc_eello(i,j,k,l,jj,kk)
7844 ! This subroutine computes matrices and vectors needed to calculate
7845 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
7848 ! implicit real*8 (a-h,o-z)
7849 ! include 'DIMENSIONS'
7850 ! include 'COMMON.IOUNITS'
7851 ! include 'COMMON.CHAIN'
7852 ! include 'COMMON.DERIV'
7853 ! include 'COMMON.INTERACT'
7854 ! include 'COMMON.CONTACTS'
7855 ! include 'COMMON.TORSION'
7856 ! include 'COMMON.VAR'
7857 ! include 'COMMON.GEO'
7858 ! include 'COMMON.FFIELD'
7859 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
7860 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
7861 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
7864 !el common /kutas/ lprn
7865 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7866 !d & ' jj=',jj,' kk=',kk
7867 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7868 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7869 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7872 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7873 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7876 call transpose2(aa1(1,1),aa1t(1,1))
7877 call transpose2(aa2(1,1),aa2t(1,1))
7880 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
7881 aa1tder(1,1,lll,kkk))
7882 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
7883 aa2tder(1,1,lll,kkk))
7887 ! parallel orientation of the two CA-CA-CA frames.
7889 iti=itortyp(itype(i))
7893 itk1=itortyp(itype(k+1))
7894 itj=itortyp(itype(j))
7895 if (l.lt.nres-1) then
7896 itl1=itortyp(itype(l+1))
7900 ! A1 kernel(j+1) A2T
7902 !d write (iout,'(3f10.5,5x,3f10.5)')
7903 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7905 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7906 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
7907 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7908 ! Following matrices are needed only for 6-th order cumulants
7909 IF (wcorr6.gt.0.0d0) THEN
7910 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7911 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
7912 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7913 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7914 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
7915 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
7916 ADtEAderx(1,1,1,1,1,1))
7918 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7919 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
7920 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
7921 ADtEA1derx(1,1,1,1,1,1))
7923 ! End 6-th order cumulants
7926 !d write (2,*) 'In calc_eello6'
7928 !d write (2,*) 'iii=',iii
7930 !d write (2,*) 'kkk=',kkk
7932 !d write (2,'(3(2f10.5),5x)')
7933 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7938 call transpose2(EUgder(1,1,k),auxmat(1,1))
7939 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7940 call transpose2(EUg(1,1,k),auxmat(1,1))
7941 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7942 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7946 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7947 EAEAderx(1,1,lll,kkk,iii,1))
7951 ! A1T kernel(i+1) A2
7952 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7953 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
7954 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7955 ! Following matrices are needed only for 6-th order cumulants
7956 IF (wcorr6.gt.0.0d0) THEN
7957 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7958 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
7959 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7960 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7961 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
7962 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
7963 ADtEAderx(1,1,1,1,1,2))
7964 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7965 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
7966 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
7967 ADtEA1derx(1,1,1,1,1,2))
7969 ! End 6-th order cumulants
7970 call transpose2(EUgder(1,1,l),auxmat(1,1))
7971 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7972 call transpose2(EUg(1,1,l),auxmat(1,1))
7973 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7974 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7978 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7979 EAEAderx(1,1,lll,kkk,iii,2))
7984 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7985 ! They are needed only when the fifth- or the sixth-order cumulants are
7987 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7988 call transpose2(AEA(1,1,1),auxmat(1,1))
7989 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7990 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7991 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7992 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7993 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7994 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7995 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7996 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7997 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7998 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7999 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8000 call transpose2(AEA(1,1,2),auxmat(1,1))
8001 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
8002 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8003 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8004 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8005 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
8006 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8007 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
8008 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
8009 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8010 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8011 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8012 ! Calculate the Cartesian derivatives of the vectors.
8016 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8017 call matvec2(auxmat(1,1),b1(1,iti),&
8018 AEAb1derx(1,lll,kkk,iii,1,1))
8019 call matvec2(auxmat(1,1),Ub2(1,i),&
8020 AEAb2derx(1,lll,kkk,iii,1,1))
8021 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8022 AEAb1derx(1,lll,kkk,iii,2,1))
8023 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8024 AEAb2derx(1,lll,kkk,iii,2,1))
8025 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8026 call matvec2(auxmat(1,1),b1(1,itj),&
8027 AEAb1derx(1,lll,kkk,iii,1,2))
8028 call matvec2(auxmat(1,1),Ub2(1,j),&
8029 AEAb2derx(1,lll,kkk,iii,1,2))
8030 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8031 AEAb1derx(1,lll,kkk,iii,2,2))
8032 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
8033 AEAb2derx(1,lll,kkk,iii,2,2))
8040 ! Antiparallel orientation of the two CA-CA-CA frames.
8042 iti=itortyp(itype(i))
8046 itk1=itortyp(itype(k+1))
8047 itl=itortyp(itype(l))
8048 itj=itortyp(itype(j))
8049 if (j.lt.nres-1) then
8050 itj1=itortyp(itype(j+1))
8054 ! A2 kernel(j-1)T A1T
8055 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8056 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
8057 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8058 ! Following matrices are needed only for 6-th order cumulants
8059 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8060 j.eq.i+4 .and. l.eq.i+3)) THEN
8061 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8062 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
8063 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8064 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8065 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
8066 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8067 ADtEAderx(1,1,1,1,1,1))
8068 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8069 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
8070 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8071 ADtEA1derx(1,1,1,1,1,1))
8073 ! End 6-th order cumulants
8074 call transpose2(EUgder(1,1,k),auxmat(1,1))
8075 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8076 call transpose2(EUg(1,1,k),auxmat(1,1))
8077 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8078 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8082 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8083 EAEAderx(1,1,lll,kkk,iii,1))
8087 ! A2T kernel(i+1)T A1
8088 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8089 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
8090 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8091 ! Following matrices are needed only for 6-th order cumulants
8092 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8093 j.eq.i+4 .and. l.eq.i+3)) THEN
8094 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8095 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
8096 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8097 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8098 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
8099 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8100 ADtEAderx(1,1,1,1,1,2))
8101 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8102 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
8103 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8104 ADtEA1derx(1,1,1,1,1,2))
8106 ! End 6-th order cumulants
8107 call transpose2(EUgder(1,1,j),auxmat(1,1))
8108 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8109 call transpose2(EUg(1,1,j),auxmat(1,1))
8110 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8111 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8115 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8116 EAEAderx(1,1,lll,kkk,iii,2))
8121 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8122 ! They are needed only when the fifth- or the sixth-order cumulants are
8124 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
8125 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8126 call transpose2(AEA(1,1,1),auxmat(1,1))
8127 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8128 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8129 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8130 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8131 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8132 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8133 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8134 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8135 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8136 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8137 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8138 call transpose2(AEA(1,1,2),auxmat(1,1))
8139 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8140 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8141 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8142 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8143 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8144 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8145 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8146 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8147 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8148 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8149 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8150 ! Calculate the Cartesian derivatives of the vectors.
8154 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8155 call matvec2(auxmat(1,1),b1(1,iti),&
8156 AEAb1derx(1,lll,kkk,iii,1,1))
8157 call matvec2(auxmat(1,1),Ub2(1,i),&
8158 AEAb2derx(1,lll,kkk,iii,1,1))
8159 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8160 AEAb1derx(1,lll,kkk,iii,2,1))
8161 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8162 AEAb2derx(1,lll,kkk,iii,2,1))
8163 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8164 call matvec2(auxmat(1,1),b1(1,itl),&
8165 AEAb1derx(1,lll,kkk,iii,1,2))
8166 call matvec2(auxmat(1,1),Ub2(1,l),&
8167 AEAb2derx(1,lll,kkk,iii,1,2))
8168 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
8169 AEAb1derx(1,lll,kkk,iii,2,2))
8170 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
8171 AEAb2derx(1,lll,kkk,iii,2,2))
8179 end subroutine calc_eello
8180 !-----------------------------------------------------------------------------
8181 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
8186 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
8187 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
8188 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
8189 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
8190 integer :: iii,kkk,lll
8193 !el common /kutas/ lprn
8194 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8196 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
8199 !d if (lprn) write (2,*) 'In kernel'
8201 !d if (lprn) write (2,*) 'kkk=',kkk
8203 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
8204 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8206 !d write (2,*) 'lll=',lll
8207 !d write (2,*) 'iii=1'
8209 !d write (2,'(3(2f10.5),5x)')
8210 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8213 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
8214 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8216 !d write (2,*) 'lll=',lll
8217 !d write (2,*) 'iii=2'
8219 !d write (2,'(3(2f10.5),5x)')
8220 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8226 end subroutine kernel
8227 !-----------------------------------------------------------------------------
8228 real(kind=8) function eello4(i,j,k,l,jj,kk)
8229 ! implicit real*8 (a-h,o-z)
8230 ! include 'DIMENSIONS'
8231 ! include 'COMMON.IOUNITS'
8232 ! include 'COMMON.CHAIN'
8233 ! include 'COMMON.DERIV'
8234 ! include 'COMMON.INTERACT'
8235 ! include 'COMMON.CONTACTS'
8236 ! include 'COMMON.TORSION'
8237 ! include 'COMMON.VAR'
8238 ! include 'COMMON.GEO'
8239 real(kind=8),dimension(2,2) :: pizda
8240 real(kind=8),dimension(3) :: ggg1,ggg2
8241 real(kind=8) :: eel4,glongij,glongkl
8242 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
8243 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8247 !d print *,'eello4:',i,j,k,l,jj,kk
8248 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
8249 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
8250 !old eij=facont_hb(jj,i)
8251 !old ekl=facont_hb(kk,k)
8253 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8254 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8255 gcorr_loc(k-1)=gcorr_loc(k-1) &
8256 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8258 gcorr_loc(l-1)=gcorr_loc(l-1) &
8259 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8261 gcorr_loc(j-1)=gcorr_loc(j-1) &
8262 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8267 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
8268 -EAEAderx(2,2,lll,kkk,iii,1)
8269 !d derx(lll,kkk,iii)=0.0d0
8273 !d gcorr_loc(l-1)=0.0d0
8274 !d gcorr_loc(j-1)=0.0d0
8275 !d gcorr_loc(k-1)=0.0d0
8277 !d write (iout,*)'Contacts have occurred for peptide groups',
8278 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
8279 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8280 if (j.lt.nres-1) then
8287 if (l.lt.nres-1) then
8295 !grad ggg1(ll)=eel4*g_contij(ll,1)
8296 !grad ggg2(ll)=eel4*g_contij(ll,2)
8297 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8298 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8299 !grad ghalf=0.5d0*ggg1(ll)
8300 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8301 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8302 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8303 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8304 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8305 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8306 !grad ghalf=0.5d0*ggg2(ll)
8307 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8308 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8309 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8310 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8311 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8312 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8316 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8321 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8326 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8331 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8335 !d write (2,*) iii,gcorr_loc(iii)
8338 !d write (2,*) 'ekont',ekont
8339 !d write (iout,*) 'eello4',ekont*eel4
8342 !-----------------------------------------------------------------------------
8343 real(kind=8) function eello5(i,j,k,l,jj,kk)
8344 ! implicit real*8 (a-h,o-z)
8345 ! include 'DIMENSIONS'
8346 ! include 'COMMON.IOUNITS'
8347 ! include 'COMMON.CHAIN'
8348 ! include 'COMMON.DERIV'
8349 ! include 'COMMON.INTERACT'
8350 ! include 'COMMON.CONTACTS'
8351 ! include 'COMMON.TORSION'
8352 ! include 'COMMON.VAR'
8353 ! include 'COMMON.GEO'
8354 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8355 real(kind=8),dimension(2) :: vv
8356 real(kind=8),dimension(3) :: ggg1,ggg2
8357 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
8358 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
8359 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
8360 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8365 ! /l\ / \ \ / \ / \ / C
8366 ! / \ / \ \ / \ / \ / C
8367 ! j| o |l1 | o | o| o | | o |o C
8368 ! \ |/k\| |/ \| / |/ \| |/ \| C
8369 ! \i/ \ / \ / / \ / \ C
8371 ! (I) (II) (III) (IV) C
8373 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8375 ! Antiparallel chains C
8378 ! /j\ / \ \ / \ / \ / C
8379 ! / \ / \ \ / \ / \ / C
8380 ! j1| o |l | o | o| o | | o |o C
8381 ! \ |/k\| |/ \| / |/ \| |/ \| C
8382 ! \i/ \ / \ / / \ / \ C
8384 ! (I) (II) (III) (IV) C
8386 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8388 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
8390 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8391 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8396 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8398 itk=itortyp(itype(k))
8399 itl=itortyp(itype(l))
8400 itj=itortyp(itype(j))
8405 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8406 !d & eel5_3_num,eel5_4_num)
8410 derx(lll,kkk,iii)=0.0d0
8414 !d eij=facont_hb(jj,i)
8415 !d ekl=facont_hb(kk,k)
8417 !d write (iout,*)'Contacts have occurred for peptide groups',
8418 !d & i,j,' fcont:',eij,' eij',' and ',k,l
8420 ! Contribution from the graph I.
8421 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8422 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8423 call transpose2(EUg(1,1,k),auxmat(1,1))
8424 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8425 vv(1)=pizda(1,1)-pizda(2,2)
8426 vv(2)=pizda(1,2)+pizda(2,1)
8427 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
8428 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8429 ! Explicit gradient in virtual-dihedral angles.
8430 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
8431 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
8432 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8433 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8434 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8435 vv(1)=pizda(1,1)-pizda(2,2)
8436 vv(2)=pizda(1,2)+pizda(2,1)
8437 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8438 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
8439 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8440 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8441 vv(1)=pizda(1,1)-pizda(2,2)
8442 vv(2)=pizda(1,2)+pizda(2,1)
8444 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8445 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8446 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8448 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8449 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8450 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8452 ! Cartesian gradient
8456 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8458 vv(1)=pizda(1,1)-pizda(2,2)
8459 vv(2)=pizda(1,2)+pizda(2,1)
8460 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8461 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
8462 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8468 ! Contribution from graph II
8469 call transpose2(EE(1,1,itk),auxmat(1,1))
8470 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8471 vv(1)=pizda(1,1)+pizda(2,2)
8472 vv(2)=pizda(2,1)-pizda(1,2)
8473 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
8474 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8475 ! Explicit gradient in virtual-dihedral angles.
8476 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8477 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8478 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8479 vv(1)=pizda(1,1)+pizda(2,2)
8480 vv(2)=pizda(2,1)-pizda(1,2)
8482 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8483 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8484 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8486 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8487 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8488 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8490 ! Cartesian gradient
8494 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8496 vv(1)=pizda(1,1)+pizda(2,2)
8497 vv(2)=pizda(2,1)-pizda(1,2)
8498 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8499 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
8500 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8508 ! Parallel orientation
8509 ! Contribution from graph III
8510 call transpose2(EUg(1,1,l),auxmat(1,1))
8511 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8512 vv(1)=pizda(1,1)-pizda(2,2)
8513 vv(2)=pizda(1,2)+pizda(2,1)
8514 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
8515 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8516 ! Explicit gradient in virtual-dihedral angles.
8517 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8518 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
8519 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8520 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8521 vv(1)=pizda(1,1)-pizda(2,2)
8522 vv(2)=pizda(1,2)+pizda(2,1)
8523 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8524 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
8525 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8526 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8527 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8528 vv(1)=pizda(1,1)-pizda(2,2)
8529 vv(2)=pizda(1,2)+pizda(2,1)
8530 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8531 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
8532 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8533 ! Cartesian gradient
8537 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8539 vv(1)=pizda(1,1)-pizda(2,2)
8540 vv(2)=pizda(1,2)+pizda(2,1)
8541 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8542 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
8543 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8548 ! Contribution from graph IV
8550 call transpose2(EE(1,1,itl),auxmat(1,1))
8551 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8552 vv(1)=pizda(1,1)+pizda(2,2)
8553 vv(2)=pizda(2,1)-pizda(1,2)
8554 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
8555 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8556 ! Explicit gradient in virtual-dihedral angles.
8557 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8558 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8559 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8560 vv(1)=pizda(1,1)+pizda(2,2)
8561 vv(2)=pizda(2,1)-pizda(1,2)
8562 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8563 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
8564 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8565 ! Cartesian gradient
8569 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8571 vv(1)=pizda(1,1)+pizda(2,2)
8572 vv(2)=pizda(2,1)-pizda(1,2)
8573 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8574 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
8575 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8580 ! Antiparallel orientation
8581 ! Contribution from graph III
8583 call transpose2(EUg(1,1,j),auxmat(1,1))
8584 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8585 vv(1)=pizda(1,1)-pizda(2,2)
8586 vv(2)=pizda(1,2)+pizda(2,1)
8587 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
8588 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8589 ! Explicit gradient in virtual-dihedral angles.
8590 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8591 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
8592 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8593 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8594 vv(1)=pizda(1,1)-pizda(2,2)
8595 vv(2)=pizda(1,2)+pizda(2,1)
8596 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8597 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
8598 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8599 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8600 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8601 vv(1)=pizda(1,1)-pizda(2,2)
8602 vv(2)=pizda(1,2)+pizda(2,1)
8603 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8604 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
8605 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8606 ! Cartesian gradient
8610 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8612 vv(1)=pizda(1,1)-pizda(2,2)
8613 vv(2)=pizda(1,2)+pizda(2,1)
8614 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
8615 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
8616 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8621 ! Contribution from graph IV
8623 call transpose2(EE(1,1,itj),auxmat(1,1))
8624 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8625 vv(1)=pizda(1,1)+pizda(2,2)
8626 vv(2)=pizda(2,1)-pizda(1,2)
8627 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
8628 -0.5d0*scalar2(vv(1),Ctobr(1,j))
8629 ! Explicit gradient in virtual-dihedral angles.
8630 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8631 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8632 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8633 vv(1)=pizda(1,1)+pizda(2,2)
8634 vv(2)=pizda(2,1)-pizda(1,2)
8635 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8636 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
8637 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8638 ! Cartesian gradient
8642 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8644 vv(1)=pizda(1,1)+pizda(2,2)
8645 vv(2)=pizda(2,1)-pizda(1,2)
8646 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
8647 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
8648 -0.5d0*scalar2(vv(1),Ctobr(1,j))
8654 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8655 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8656 !d write (2,*) 'ijkl',i,j,k,l
8657 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8658 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
8660 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8661 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8662 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8663 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8664 if (j.lt.nres-1) then
8671 if (l.lt.nres-1) then
8681 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8682 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
8683 ! summed up outside the subrouine as for the other subroutines
8684 ! handling long-range interactions. The old code is commented out
8685 ! with "cgrad" to keep track of changes.
8687 !grad ggg1(ll)=eel5*g_contij(ll,1)
8688 !grad ggg2(ll)=eel5*g_contij(ll,2)
8689 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8690 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8691 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8692 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8693 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8694 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8695 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8696 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8698 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8699 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8700 !grad ghalf=0.5d0*ggg1(ll)
8702 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8703 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8704 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8705 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8706 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8707 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8708 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8709 !grad ghalf=0.5d0*ggg2(ll)
8711 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8712 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8713 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8714 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8715 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8716 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8721 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8722 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8727 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8728 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8734 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8739 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8743 !d write (2,*) iii,g_corr5_loc(iii)
8746 !d write (2,*) 'ekont',ekont
8747 !d write (iout,*) 'eello5',ekont*eel5
8750 !-----------------------------------------------------------------------------
8751 real(kind=8) function eello6(i,j,k,l,jj,kk)
8752 ! implicit real*8 (a-h,o-z)
8753 ! include 'DIMENSIONS'
8754 ! include 'COMMON.IOUNITS'
8755 ! include 'COMMON.CHAIN'
8756 ! include 'COMMON.DERIV'
8757 ! include 'COMMON.INTERACT'
8758 ! include 'COMMON.CONTACTS'
8759 ! include 'COMMON.TORSION'
8760 ! include 'COMMON.VAR'
8761 ! include 'COMMON.GEO'
8762 ! include 'COMMON.FFIELD'
8763 real(kind=8),dimension(3) :: ggg1,ggg2
8764 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
8766 real(kind=8) :: gradcorr6ij,gradcorr6kl
8767 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
8768 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8773 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8781 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8782 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8786 derx(lll,kkk,iii)=0.0d0
8790 !d eij=facont_hb(jj,i)
8791 !d ekl=facont_hb(kk,k)
8797 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8798 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8799 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8800 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8801 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8802 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8804 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8805 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8806 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8807 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8808 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8809 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8813 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8815 ! If turn contributions are considered, they will be handled separately.
8816 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8817 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8818 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8819 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8820 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8821 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8822 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8824 if (j.lt.nres-1) then
8831 if (l.lt.nres-1) then
8839 !grad ggg1(ll)=eel6*g_contij(ll,1)
8840 !grad ggg2(ll)=eel6*g_contij(ll,2)
8841 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8842 !grad ghalf=0.5d0*ggg1(ll)
8844 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8845 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8846 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8847 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8848 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8849 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8850 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8851 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8852 !grad ghalf=0.5d0*ggg2(ll)
8853 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8855 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8856 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8857 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8858 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8859 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8860 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8865 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8866 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8871 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8872 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8878 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8883 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8887 !d write (2,*) iii,g_corr6_loc(iii)
8890 !d write (2,*) 'ekont',ekont
8891 !d write (iout,*) 'eello6',ekont*eel6
8894 !-----------------------------------------------------------------------------
8895 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
8897 ! implicit real*8 (a-h,o-z)
8898 ! include 'DIMENSIONS'
8899 ! include 'COMMON.IOUNITS'
8900 ! include 'COMMON.CHAIN'
8901 ! include 'COMMON.DERIV'
8902 ! include 'COMMON.INTERACT'
8903 ! include 'COMMON.CONTACTS'
8904 ! include 'COMMON.TORSION'
8905 ! include 'COMMON.VAR'
8906 ! include 'COMMON.GEO'
8907 real(kind=8),dimension(2) :: vv,vv1
8908 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
8911 !el common /kutas/ lprn
8912 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
8913 real(kind=8) :: s1,s2,s3,s4,s5
8914 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8916 ! Parallel Antiparallel C
8922 ! \ j|/k\| / \ |/k\|l / C
8927 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8928 itk=itortyp(itype(k))
8929 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8930 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8931 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8932 call transpose2(EUgC(1,1,k),auxmat(1,1))
8933 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8934 vv1(1)=pizda1(1,1)-pizda1(2,2)
8935 vv1(2)=pizda1(1,2)+pizda1(2,1)
8936 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8937 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8938 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8939 s5=scalar2(vv(1),Dtobr2(1,i))
8940 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8941 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8942 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
8943 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
8944 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
8945 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
8946 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
8947 +scalar2(vv(1),Dtobr2der(1,i)))
8948 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8949 vv1(1)=pizda1(1,1)-pizda1(2,2)
8950 vv1(2)=pizda1(1,2)+pizda1(2,1)
8951 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8952 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8954 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
8955 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
8956 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
8957 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
8958 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8960 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
8961 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
8962 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
8963 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
8964 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8966 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8967 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8968 vv1(1)=pizda1(1,1)-pizda1(2,2)
8969 vv1(2)=pizda1(1,2)+pizda1(2,1)
8970 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
8971 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
8972 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
8973 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8982 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8983 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8984 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8985 call transpose2(EUgC(1,1,k),auxmat(1,1))
8986 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
8988 vv1(1)=pizda1(1,1)-pizda1(2,2)
8989 vv1(2)=pizda1(1,2)+pizda1(2,1)
8990 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8991 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
8992 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8993 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
8994 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8995 s5=scalar2(vv(1),Dtobr2(1,i))
8996 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9001 end function eello6_graph1
9002 !-----------------------------------------------------------------------------
9003 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
9005 ! implicit real*8 (a-h,o-z)
9006 ! include 'DIMENSIONS'
9007 ! include 'COMMON.IOUNITS'
9008 ! include 'COMMON.CHAIN'
9009 ! include 'COMMON.DERIV'
9010 ! include 'COMMON.INTERACT'
9011 ! include 'COMMON.CONTACTS'
9012 ! include 'COMMON.TORSION'
9013 ! include 'COMMON.VAR'
9014 ! include 'COMMON.GEO'
9016 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
9017 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9019 !el common /kutas/ lprn
9020 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
9021 real(kind=8) :: s2,s3,s4
9022 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9024 ! Parallel Antiparallel C
9030 ! \ j|/k\| \ |/k\|l C
9035 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9036 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9037 ! AL 7/4/01 s1 would occur in the sixth-order moment,
9038 ! but not in a cluster cumulant
9040 s1=dip(1,jj,i)*dip(1,kk,k)
9042 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9043 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9044 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9045 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9046 call transpose2(EUg(1,1,k),auxmat(1,1))
9047 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9048 vv(1)=pizda(1,1)-pizda(2,2)
9049 vv(2)=pizda(1,2)+pizda(2,1)
9050 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9051 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9053 eello6_graph2=-(s1+s2+s3+s4)
9055 eello6_graph2=-(s2+s3+s4)
9058 ! Derivatives in gamma(i-1)
9061 s1=dipderg(1,jj,i)*dip(1,kk,k)
9063 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9064 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9065 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9066 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9068 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9070 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9072 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9074 ! Derivatives in gamma(k-1)
9076 s1=dip(1,jj,i)*dipderg(1,kk,k)
9078 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9079 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9080 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9081 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9082 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9083 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9084 vv(1)=pizda(1,1)-pizda(2,2)
9085 vv(2)=pizda(1,2)+pizda(2,1)
9086 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9088 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9090 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9092 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9093 ! Derivatives in gamma(j-1) or gamma(l-1)
9096 s1=dipderg(3,jj,i)*dip(1,kk,k)
9098 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9099 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9100 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9101 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9102 vv(1)=pizda(1,1)-pizda(2,2)
9103 vv(2)=pizda(1,2)+pizda(2,1)
9104 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9107 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9109 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9112 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9113 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9115 ! Derivatives in gamma(l-1) or gamma(j-1)
9118 s1=dip(1,jj,i)*dipderg(3,kk,k)
9120 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9121 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9122 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9123 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9124 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9125 vv(1)=pizda(1,1)-pizda(2,2)
9126 vv(2)=pizda(1,2)+pizda(2,1)
9127 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9130 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9132 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9135 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9136 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9138 ! Cartesian derivatives.
9140 write (2,*) 'In eello6_graph2'
9142 write (2,*) 'iii=',iii
9144 write (2,*) 'kkk=',kkk
9146 write (2,'(3(2f10.5),5x)') &
9147 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9157 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9159 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9162 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
9164 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9165 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
9167 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9168 call transpose2(EUg(1,1,k),auxmat(1,1))
9169 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
9171 vv(1)=pizda(1,1)-pizda(2,2)
9172 vv(2)=pizda(1,2)+pizda(2,1)
9173 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9174 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9176 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9178 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9181 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9183 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9189 end function eello6_graph2
9190 !-----------------------------------------------------------------------------
9191 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
9192 ! implicit real*8 (a-h,o-z)
9193 ! include 'DIMENSIONS'
9194 ! include 'COMMON.IOUNITS'
9195 ! include 'COMMON.CHAIN'
9196 ! include 'COMMON.DERIV'
9197 ! include 'COMMON.INTERACT'
9198 ! include 'COMMON.CONTACTS'
9199 ! include 'COMMON.TORSION'
9200 ! include 'COMMON.VAR'
9201 ! include 'COMMON.GEO'
9202 real(kind=8),dimension(2) :: vv,auxvec
9203 real(kind=8),dimension(2,2) :: pizda,auxmat
9205 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
9206 real(kind=8) :: s1,s2,s3,s4
9207 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9209 ! Parallel Antiparallel C
9215 ! j|/k\| / |/k\|l / C
9220 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9222 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9223 ! energy moment and not to the cluster cumulant.
9224 iti=itortyp(itype(i))
9225 if (j.lt.nres-1) then
9226 itj1=itortyp(itype(j+1))
9230 itk=itortyp(itype(k))
9231 itk1=itortyp(itype(k+1))
9232 if (l.lt.nres-1) then
9233 itl1=itortyp(itype(l+1))
9238 s1=dip(4,jj,i)*dip(4,kk,k)
9240 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9241 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9242 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9243 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9244 call transpose2(EE(1,1,itk),auxmat(1,1))
9245 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9246 vv(1)=pizda(1,1)+pizda(2,2)
9247 vv(2)=pizda(2,1)-pizda(1,2)
9248 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9249 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9250 !d & "sum",-(s2+s3+s4)
9252 eello6_graph3=-(s1+s2+s3+s4)
9254 eello6_graph3=-(s2+s3+s4)
9257 ! Derivatives in gamma(k-1)
9258 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9259 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9260 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9261 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9262 ! Derivatives in gamma(l-1)
9263 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9264 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9265 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9266 vv(1)=pizda(1,1)+pizda(2,2)
9267 vv(2)=pizda(2,1)-pizda(1,2)
9268 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9269 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9270 ! Cartesian derivatives.
9276 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9278 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9281 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9283 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9284 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
9286 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9287 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
9289 vv(1)=pizda(1,1)+pizda(2,2)
9290 vv(2)=pizda(2,1)-pizda(1,2)
9291 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9293 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9295 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9298 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9300 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9302 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9307 end function eello6_graph3
9308 !-----------------------------------------------------------------------------
9309 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9310 ! implicit real*8 (a-h,o-z)
9311 ! include 'DIMENSIONS'
9312 ! include 'COMMON.IOUNITS'
9313 ! include 'COMMON.CHAIN'
9314 ! include 'COMMON.DERIV'
9315 ! include 'COMMON.INTERACT'
9316 ! include 'COMMON.CONTACTS'
9317 ! include 'COMMON.TORSION'
9318 ! include 'COMMON.VAR'
9319 ! include 'COMMON.GEO'
9320 ! include 'COMMON.FFIELD'
9321 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
9322 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9324 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
9326 real(kind=8) :: s1,s2,s3,s4
9327 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9329 ! Parallel Antiparallel C
9335 ! \ j|/k\| \ |/k\|l C
9340 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9342 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9343 ! energy moment and not to the cluster cumulant.
9344 !d write (2,*) 'eello_graph4: wturn6',wturn6
9345 iti=itortyp(itype(i))
9346 itj=itortyp(itype(j))
9347 if (j.lt.nres-1) then
9348 itj1=itortyp(itype(j+1))
9352 itk=itortyp(itype(k))
9353 if (k.lt.nres-1) then
9354 itk1=itortyp(itype(k+1))
9358 itl=itortyp(itype(l))
9359 if (l.lt.nres-1) then
9360 itl1=itortyp(itype(l+1))
9364 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9365 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9366 !d & ' itl',itl,' itl1',itl1
9369 s1=dip(3,jj,i)*dip(3,kk,k)
9371 s1=dip(2,jj,j)*dip(2,kk,l)
9374 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9375 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9377 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9378 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9380 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9381 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9383 call transpose2(EUg(1,1,k),auxmat(1,1))
9384 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9385 vv(1)=pizda(1,1)-pizda(2,2)
9386 vv(2)=pizda(2,1)+pizda(1,2)
9387 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9388 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9390 eello6_graph4=-(s1+s2+s3+s4)
9392 eello6_graph4=-(s2+s3+s4)
9394 ! Derivatives in gamma(i-1)
9398 s1=dipderg(2,jj,i)*dip(3,kk,k)
9400 s1=dipderg(4,jj,j)*dip(2,kk,l)
9403 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9405 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9406 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9408 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9409 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9411 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9412 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9413 !d write (2,*) 'turn6 derivatives'
9415 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9417 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9421 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9423 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9427 ! Derivatives in gamma(k-1)
9430 s1=dip(3,jj,i)*dipderg(2,kk,k)
9432 s1=dip(2,jj,j)*dipderg(4,kk,l)
9435 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9436 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9438 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9439 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9441 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9442 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9444 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9445 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9446 vv(1)=pizda(1,1)-pizda(2,2)
9447 vv(2)=pizda(2,1)+pizda(1,2)
9448 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9449 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9451 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9453 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9457 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9459 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9462 ! Derivatives in gamma(j-1) or gamma(l-1)
9463 if (l.eq.j+1 .and. l.gt.1) then
9464 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9465 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9466 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9467 vv(1)=pizda(1,1)-pizda(2,2)
9468 vv(2)=pizda(2,1)+pizda(1,2)
9469 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9470 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9471 else if (j.gt.1) then
9472 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9473 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9474 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9475 vv(1)=pizda(1,1)-pizda(2,2)
9476 vv(2)=pizda(2,1)+pizda(1,2)
9477 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9478 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9479 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9481 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9484 ! Cartesian derivatives.
9491 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9493 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9497 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9499 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9503 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
9505 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9507 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9508 b1(1,itj1),auxvec(1))
9509 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9511 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9512 b1(1,itl1),auxvec(1))
9513 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9515 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9517 vv(1)=pizda(1,1)-pizda(2,2)
9518 vv(2)=pizda(2,1)+pizda(1,2)
9519 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9521 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9523 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9526 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9529 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9532 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9534 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9536 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9540 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9542 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9545 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9547 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9554 end function eello6_graph4
9555 !-----------------------------------------------------------------------------
9556 real(kind=8) function eello_turn6(i,jj,kk)
9557 ! implicit real*8 (a-h,o-z)
9558 ! include 'DIMENSIONS'
9559 ! include 'COMMON.IOUNITS'
9560 ! include 'COMMON.CHAIN'
9561 ! include 'COMMON.DERIV'
9562 ! include 'COMMON.INTERACT'
9563 ! include 'COMMON.CONTACTS'
9564 ! include 'COMMON.TORSION'
9565 ! include 'COMMON.VAR'
9566 ! include 'COMMON.GEO'
9567 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
9568 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
9569 real(kind=8),dimension(3) :: ggg1,ggg2
9570 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
9571 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
9572 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9573 ! the respective energy moment and not to the cluster cumulant.
9575 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
9576 integer :: j1,j2,l1,l2,ll
9577 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
9578 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
9587 iti=itortyp(itype(i))
9588 itk=itortyp(itype(k))
9589 itk1=itortyp(itype(k+1))
9590 itl=itortyp(itype(l))
9591 itj=itortyp(itype(j))
9592 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9593 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
9594 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9599 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9601 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
9605 derx_turn(lll,kkk,iii)=0.0d0
9612 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9614 !d write (2,*) 'eello6_5',eello6_5
9616 call transpose2(AEA(1,1,1),auxmat(1,1))
9617 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9618 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9619 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9621 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9622 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9623 s2 = scalar2(b1(1,itk),vtemp1(1))
9625 call transpose2(AEA(1,1,2),atemp(1,1))
9626 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9627 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9628 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9630 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9631 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9632 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9634 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9635 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9636 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9637 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9638 ss13 = scalar2(b1(1,itk),vtemp4(1))
9639 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9641 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9647 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9648 ! Derivatives in gamma(i+2)
9652 call transpose2(AEA(1,1,1),auxmatd(1,1))
9653 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9654 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9655 call transpose2(AEAderg(1,1,2),atempd(1,1))
9656 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9657 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9659 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9660 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9661 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9667 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9668 ! Derivatives in gamma(i+3)
9670 call transpose2(AEA(1,1,1),auxmatd(1,1))
9671 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9672 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9673 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9675 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9676 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9677 s2d = scalar2(b1(1,itk),vtemp1d(1))
9679 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9680 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9682 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9684 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9685 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9686 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9694 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
9695 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9697 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
9698 -0.5d0*ekont*(s2d+s12d)
9700 ! Derivatives in gamma(i+4)
9701 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9702 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9703 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9705 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9706 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9707 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9715 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9717 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9719 ! Derivatives in gamma(i+5)
9721 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9722 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9723 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9725 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9726 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9727 s2d = scalar2(b1(1,itk),vtemp1d(1))
9729 call transpose2(AEA(1,1,2),atempd(1,1))
9730 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9731 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9733 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9734 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9736 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9737 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9738 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9746 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
9747 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9749 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
9750 -0.5d0*ekont*(s2d+s12d)
9752 ! Cartesian derivatives
9757 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9758 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9759 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9761 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9762 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
9764 s2d = scalar2(b1(1,itk),vtemp1d(1))
9766 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9767 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9768 s8d = -(atempd(1,1)+atempd(2,2))* &
9769 scalar2(cc(1,1,itl),vtemp2(1))
9771 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
9773 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9774 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9781 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
9784 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
9788 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
9791 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
9800 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
9802 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9803 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9804 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9805 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9806 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
9808 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9809 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9810 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9814 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9815 !d & 16*eel_turn6_num
9817 if (j.lt.nres-1) then
9824 if (l.lt.nres-1) then
9832 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
9833 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
9834 !grad ghalf=0.5d0*ggg1(ll)
9836 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9837 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9838 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
9839 +ekont*derx_turn(ll,2,1)
9840 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9841 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
9842 +ekont*derx_turn(ll,4,1)
9843 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9844 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9845 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9846 !grad ghalf=0.5d0*ggg2(ll)
9848 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
9849 +ekont*derx_turn(ll,2,2)
9850 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9851 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
9852 +ekont*derx_turn(ll,4,2)
9853 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9854 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9855 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9860 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9865 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9871 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9876 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9880 !d write (2,*) iii,g_corr6_loc(iii)
9882 eello_turn6=ekont*eel_turn6
9883 !d write (2,*) 'ekont',ekont
9884 !d write (2,*) 'eel_turn6',ekont*eel_turn6
9886 end function eello_turn6
9887 !-----------------------------------------------------------------------------
9888 subroutine MATVEC2(A1,V1,V2)
9889 !DIR$ INLINEALWAYS MATVEC2
9891 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9893 ! implicit real*8 (a-h,o-z)
9894 ! include 'DIMENSIONS'
9895 real(kind=8),dimension(2) :: V1,V2
9896 real(kind=8),dimension(2,2) :: A1
9897 real(kind=8) :: vaux1,vaux2
9901 ! 3 VI=VI+A1(I,K)*V1(K)
9905 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9906 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9910 end subroutine MATVEC2
9911 !-----------------------------------------------------------------------------
9912 subroutine MATMAT2(A1,A2,A3)
9914 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9916 ! implicit real*8 (a-h,o-z)
9917 ! include 'DIMENSIONS'
9918 real(kind=8),dimension(2,2) :: A1,A2,A3
9919 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
9920 ! DIMENSION AI3(2,2)
9924 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
9930 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9931 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9932 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9933 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9939 end subroutine MATMAT2
9940 !-----------------------------------------------------------------------------
9941 real(kind=8) function scalar2(u,v)
9942 !DIR$ INLINEALWAYS scalar2
9944 real(kind=8),dimension(2) :: u,v
9947 scalar2=u(1)*v(1)+u(2)*v(2)
9949 end function scalar2
9950 !-----------------------------------------------------------------------------
9951 subroutine transpose2(a,at)
9952 !DIR$ INLINEALWAYS transpose2
9954 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
9957 real(kind=8),dimension(2,2) :: a,at
9963 end subroutine transpose2
9964 !-----------------------------------------------------------------------------
9965 subroutine transpose(n,a,at)
9968 real(kind=8),dimension(n,n) :: a,at
9975 end subroutine transpose
9976 !-----------------------------------------------------------------------------
9977 subroutine prodmat3(a1,a2,kk,transp,prod)
9978 !DIR$ INLINEALWAYS prodmat3
9980 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
9984 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
9986 !rc double precision auxmat(2,2),prod_(2,2)
9989 !rc call transpose2(kk(1,1),auxmat(1,1))
9990 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9991 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9993 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
9994 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9995 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
9996 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9997 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
9998 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9999 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
10000 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10003 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10004 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10006 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
10007 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10008 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
10009 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10010 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
10011 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10012 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
10013 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10016 ! call transpose2(a2(1,1),a2t(1,1))
10019 !rc print *,((prod_(i,j),i=1,2),j=1,2)
10020 !rc print *,((prod(i,j),i=1,2),j=1,2)
10023 end subroutine prodmat3
10024 !-----------------------------------------------------------------------------
10025 ! energy_p_new_barrier.F
10026 !-----------------------------------------------------------------------------
10027 subroutine sum_gradient
10028 ! implicit real*8 (a-h,o-z)
10029 use io_base, only: pdbout
10030 ! include 'DIMENSIONS'
10034 !MS$ATTRIBUTES C :: proc_proc
10040 real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
10041 gloc_scbuf !(3,maxres)
10043 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
10045 !el local variables
10046 integer :: i,j,k,ierror,ierr
10047 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
10048 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
10049 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
10050 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
10051 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
10052 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
10053 gsccorr_max,gsccorrx_max,time00
10055 ! include 'COMMON.SETUP'
10056 ! include 'COMMON.IOUNITS'
10057 ! include 'COMMON.FFIELD'
10058 ! include 'COMMON.DERIV'
10059 ! include 'COMMON.INTERACT'
10060 ! include 'COMMON.SBRIDGE'
10061 ! include 'COMMON.CHAIN'
10062 ! include 'COMMON.VAR'
10063 ! include 'COMMON.CONTROL'
10064 ! include 'COMMON.TIME1'
10065 ! include 'COMMON.MAXGRAD'
10066 ! include 'COMMON.SCCOR'
10071 write (iout,*) "sum_gradient gvdwc, gvdwx"
10073 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10074 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
10084 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
10085 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
10086 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
10089 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
10090 ! in virtual-bond-vector coordinates
10093 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
10095 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
10096 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
10098 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
10100 ! write (iout,'(i5,3f10.5,2x,f10.5)')
10101 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
10103 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
10105 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10106 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
10107 (gvdwc_scpp(j,i),j=1,3)
10109 write (iout,*) "gelc_long gvdwpp gel_loc_long"
10111 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10112 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
10113 (gelc_loc_long(j,i),j=1,3)
10120 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10121 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10122 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10123 wel_loc*gel_loc_long(j,i)+ &
10124 wcorr*gradcorr_long(j,i)+ &
10125 wcorr5*gradcorr5_long(j,i)+ &
10126 wcorr6*gradcorr6_long(j,i)+ &
10127 wturn6*gcorr6_turn_long(j,i)+ &
10128 wstrain*ghpbc(j,i) &
10129 +wliptran*gliptranc(j,i) &
10130 +welec*gshieldc(j,i) &
10131 +wcorr*gshieldc_ec(j,i) &
10132 +wturn3*gshieldc_t3(j,i)&
10133 +wturn4*gshieldc_t4(j,i)&
10134 +wel_loc*gshieldc_ll(j,i)
10142 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10143 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10144 welec*gelc_long(j,i)+ &
10145 wbond*gradb(j,i)+ &
10146 wel_loc*gel_loc_long(j,i)+ &
10147 wcorr*gradcorr_long(j,i)+ &
10148 wcorr5*gradcorr5_long(j,i)+ &
10149 wcorr6*gradcorr6_long(j,i)+ &
10150 wturn6*gcorr6_turn_long(j,i)+ &
10151 wstrain*ghpbc(j,i) &
10152 +wliptran*gliptranc(j,i) &
10153 +welec*gshieldc(j,i)&
10154 +wcorr*gshieldc_ec(j,i) &
10155 +wturn4*gshieldc_t4(j,i) &
10156 +wel_loc*gshieldc_ll(j,i)
10163 if (nfgtasks.gt.1) then
10166 write (iout,*) "gradbufc before allreduce"
10168 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10174 gradbufc_sum(j,i)=gradbufc(j,i)
10177 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
10178 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
10179 ! time_reduce=time_reduce+MPI_Wtime()-time00
10181 ! write (iout,*) "gradbufc_sum after allreduce"
10183 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
10188 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
10192 gradbufc(k,i)=0.0d0
10196 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
10197 write (iout,*) (i," jgrad_start",jgrad_start(i),&
10198 " jgrad_end ",jgrad_end(i),&
10199 i=igrad_start,igrad_end)
10202 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
10203 ! do not parallelize this part.
10205 ! do i=igrad_start,igrad_end
10206 ! do j=jgrad_start(i),jgrad_end(i)
10208 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
10213 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10217 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10221 write (iout,*) "gradbufc after summing"
10223 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10231 write (iout,*) "gradbufc"
10233 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10240 gradbufc_sum(j,i)=gradbufc(j,i)
10241 gradbufc(j,i)=0.0d0
10245 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10249 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10254 ! gradbufc(k,i)=0.0d0
10258 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
10264 write (iout,*) "gradbufc after summing"
10266 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10275 gradbufc(k,nres)=0.0d0
10277 !el----------------
10278 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
10279 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
10280 !el-----------------
10284 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10285 wel_loc*gel_loc(j,i)+ &
10286 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10287 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10288 wel_loc*gel_loc_long(j,i)+ &
10289 wcorr*gradcorr_long(j,i)+ &
10290 wcorr5*gradcorr5_long(j,i)+ &
10291 wcorr6*gradcorr6_long(j,i)+ &
10292 wturn6*gcorr6_turn_long(j,i))+ &
10293 wbond*gradb(j,i)+ &
10294 wcorr*gradcorr(j,i)+ &
10295 wturn3*gcorr3_turn(j,i)+ &
10296 wturn4*gcorr4_turn(j,i)+ &
10297 wcorr5*gradcorr5(j,i)+ &
10298 wcorr6*gradcorr6(j,i)+ &
10299 wturn6*gcorr6_turn(j,i)+ &
10300 wsccor*gsccorc(j,i) &
10301 +wscloc*gscloc(j,i) &
10302 +wliptran*gliptranc(j,i) &
10303 +welec*gshieldc(j,i) &
10304 +welec*gshieldc_loc(j,i) &
10305 +wcorr*gshieldc_ec(j,i) &
10306 +wcorr*gshieldc_loc_ec(j,i) &
10307 +wturn3*gshieldc_t3(j,i) &
10308 +wturn3*gshieldc_loc_t3(j,i) &
10309 +wturn4*gshieldc_t4(j,i) &
10310 +wturn4*gshieldc_loc_t4(j,i) &
10311 +wel_loc*gshieldc_ll(j,i) &
10312 +wel_loc*gshieldc_loc_ll(j,i)
10315 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10316 wel_loc*gel_loc(j,i)+ &
10317 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10318 welec*gelc_long(j,i)+ &
10319 wel_loc*gel_loc_long(j,i)+ &
10320 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
10321 wcorr5*gradcorr5_long(j,i)+ &
10322 wcorr6*gradcorr6_long(j,i)+ &
10323 wturn6*gcorr6_turn_long(j,i))+ &
10324 wbond*gradb(j,i)+ &
10325 wcorr*gradcorr(j,i)+ &
10326 wturn3*gcorr3_turn(j,i)+ &
10327 wturn4*gcorr4_turn(j,i)+ &
10328 wcorr5*gradcorr5(j,i)+ &
10329 wcorr6*gradcorr6(j,i)+ &
10330 wturn6*gcorr6_turn(j,i)+ &
10331 wsccor*gsccorc(j,i) &
10332 +wscloc*gscloc(j,i) &
10333 +wliptran*gliptranc(j,i) &
10334 +welec*gshieldc(j,i) &
10335 +welec*gshieldc_loc(j,) &
10336 +wcorr*gshieldc_ec(j,i) &
10337 +wcorr*gshieldc_loc_ec(j,i) &
10338 +wturn3*gshieldc_t3(j,i) &
10339 +wturn3*gshieldc_loc_t3(j,i) &
10340 +wturn4*gshieldc_t4(j,i) &
10341 +wturn4*gshieldc_loc_t4(j,i) &
10342 +wel_loc*gshieldc_ll(j,i) &
10343 +wel_loc*gshieldc_loc_ll(j,i)
10347 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
10348 wbond*gradbx(j,i)+ &
10349 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
10350 wsccor*gsccorx(j,i) &
10351 +wscloc*gsclocx(j,i) &
10352 +wliptran*gliptranx(j,i) &
10353 +welec*gshieldx(j,i) &
10354 +wcorr*gshieldx_ec(j,i) &
10355 +wturn3*gshieldx_t3(j,i) &
10356 +wturn4*gshieldx_t4(j,i) &
10357 +wel_loc*gshieldx_ll(j,i)
10362 write (iout,*) "gloc before adding corr"
10364 write (iout,*) i,gloc(i,icg)
10368 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
10369 +wcorr5*g_corr5_loc(i) &
10370 +wcorr6*g_corr6_loc(i) &
10371 +wturn4*gel_loc_turn4(i) &
10372 +wturn3*gel_loc_turn3(i) &
10373 +wturn6*gel_loc_turn6(i) &
10374 +wel_loc*gel_loc_loc(i)
10377 write (iout,*) "gloc after adding corr"
10379 write (iout,*) i,gloc(i,icg)
10383 if (nfgtasks.gt.1) then
10386 gradbufc(j,i)=gradc(j,i,icg)
10387 gradbufx(j,i)=gradx(j,i,icg)
10391 glocbuf(i)=gloc(i,icg)
10395 write (iout,*) "gloc_sc before reduce"
10398 write (iout,*) i,j,gloc_sc(j,i,icg)
10405 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
10409 call MPI_Barrier(FG_COMM,IERR)
10410 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
10412 call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
10413 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10414 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,&
10415 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10416 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
10417 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10418 time_reduce=time_reduce+MPI_Wtime()-time00
10419 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
10420 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10421 time_reduce=time_reduce+MPI_Wtime()-time00
10424 write (iout,*) "gloc_sc after reduce"
10427 write (iout,*) i,j,gloc_sc(j,i,icg)
10433 write (iout,*) "gloc after reduce"
10435 write (iout,*) i,gloc(i,icg)
10440 if (gnorm_check) then
10442 ! Compute the maximum elements of the gradient
10445 gvdwc_scp_max=0.0d0
10452 gcorr3_turn_max=0.0d0
10453 gcorr4_turn_max=0.0d0
10454 gradcorr5_max=0.0d0
10455 gradcorr6_max=0.0d0
10456 gcorr6_turn_max=0.0d0
10460 gradx_scp_max=0.0d0
10466 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
10467 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
10468 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
10469 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
10470 gvdwc_scp_max=gvdwc_scp_norm
10471 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
10472 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
10473 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
10474 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
10475 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
10476 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
10477 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
10478 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
10479 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
10480 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
10481 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
10482 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
10483 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
10485 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
10486 gcorr3_turn_max=gcorr3_turn_norm
10487 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
10489 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
10490 gcorr4_turn_max=gcorr4_turn_norm
10491 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
10492 if (gradcorr5_norm.gt.gradcorr5_max) &
10493 gradcorr5_max=gradcorr5_norm
10494 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
10495 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
10496 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
10498 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
10499 gcorr6_turn_max=gcorr6_turn_norm
10500 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
10501 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
10502 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
10503 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
10504 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
10505 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
10506 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
10507 if (gradx_scp_norm.gt.gradx_scp_max) &
10508 gradx_scp_max=gradx_scp_norm
10509 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
10510 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
10511 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
10512 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
10513 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
10514 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
10515 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
10516 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
10520 open(istat,file=statname,position="append")
10522 open(istat,file=statname,access="append")
10524 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
10525 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
10526 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
10527 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
10528 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
10529 gsccorx_max,gsclocx_max
10531 if (gvdwc_max.gt.1.0d4) then
10532 write (iout,*) "gvdwc gvdwx gradb gradbx"
10534 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
10535 gradb(j,i),gradbx(j,i),j=1,3)
10537 call pdbout(0.0d0,'cipiszcze',iout)
10544 write (iout,*) "gradc gradx gloc"
10546 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
10547 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
10552 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
10555 end subroutine sum_gradient
10556 !-----------------------------------------------------------------------------
10558 ! implicit real*8 (a-h,o-z)
10560 ! include 'DIMENSIONS'
10561 ! include 'COMMON.CHAIN'
10562 ! include 'COMMON.DERIV'
10563 ! include 'COMMON.CALC'
10564 ! include 'COMMON.IOUNITS'
10565 real(kind=8), dimension(3) :: dcosom1,dcosom2
10567 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
10568 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
10569 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
10570 -2.0D0*alf12*eps3der+sigder*sigsq_om12
10574 ! eom12=evdwij*eps1_om12
10576 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
10578 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
10579 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
10580 !C print *,sss_ele_cut,'in sc_grad'
10582 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
10583 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
10586 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
10587 !C print *,'gg',k,gg(k)
10589 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
10590 ! write (iout,*) "gg",(gg(k),k=1,3)
10592 gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
10593 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
10594 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
10597 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
10598 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
10599 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
10602 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
10603 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
10604 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
10605 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
10608 ! Calculate the components of the gradient in DC and X
10612 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
10616 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
10617 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
10620 end subroutine sc_grad
10622 !-----------------------------------------------------------------------------
10623 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
10626 ! implicit real*8 (a-h,o-z)
10627 ! include 'DIMENSIONS'
10628 ! include 'COMMON.LOCAL'
10629 ! include 'COMMON.IOUNITS'
10630 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
10631 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
10632 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
10633 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
10634 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
10636 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
10637 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
10638 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
10639 !el local variables
10641 delthec=thetai-thet_pred_mean
10642 delthe0=thetai-theta0i
10643 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
10644 t3 = thetai-thet_pred_mean
10648 t14 = t12+t6*sigsqtc
10650 t21 = thetai-theta0i
10656 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
10657 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
10658 *(-t12*t9-ak*sig0inv*t27)
10660 end subroutine mixder
10662 !-----------------------------------------------------------------------------
10664 !-----------------------------------------------------------------------------
10666 !-----------------------------------------------------------------------------
10667 ! This subroutine calculates the derivatives of the consecutive virtual
10668 ! bond vectors and the SC vectors in the virtual-bond angles theta and
10669 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
10670 ! in the angles alpha and omega, describing the location of a side chain
10671 ! in its local coordinate system.
10673 ! The derivatives are stored in the following arrays:
10675 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
10676 ! The structure is as follows:
10678 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
10679 ! 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)
10680 ! . . . . . . . . . . . . . . . . . .
10681 ! 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)
10685 ! 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)
10687 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
10688 ! The structure is same as above.
10690 ! DCDS - the derivatives of the side chain vectors in the local spherical
10691 ! andgles alph and omega:
10693 ! 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)
10694 ! 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)
10698 ! 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)
10700 ! Version of March '95, based on an early version of November '91.
10702 !**********************************************************************
10703 ! implicit real*8 (a-h,o-z)
10704 ! include 'DIMENSIONS'
10705 ! include 'COMMON.VAR'
10706 ! include 'COMMON.CHAIN'
10707 ! include 'COMMON.DERIV'
10708 ! include 'COMMON.GEO'
10709 ! include 'COMMON.LOCAL'
10710 ! include 'COMMON.INTERACT'
10711 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
10712 real(kind=8),dimension(3,3) :: dp,temp
10713 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
10714 real(kind=8),dimension(3) :: xx,xx1
10715 !el local variables
10716 integer :: i,k,l,j,m,ind,ind1,jjj
10717 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
10718 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
10719 sint2,xp,yp,xxp,yyp,zzp,dj
10721 ! common /przechowalnia/ fromto
10722 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
10723 ! get the position of the jth ijth fragment of the chain coordinate system
10724 ! in the fromto array.
10725 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
10727 ! maxdim=(nres-1)*(nres-2)/2
10728 ! allocate(dcdv(6,maxdim),dxds(6,nres))
10729 ! calculate the derivatives of transformation matrix elements in theta
10732 !el call flush(iout) !el
10734 rdt(1,1,i)=-rt(1,2,i)
10735 rdt(1,2,i)= rt(1,1,i)
10737 rdt(2,1,i)=-rt(2,2,i)
10738 rdt(2,2,i)= rt(2,1,i)
10740 rdt(3,1,i)=-rt(3,2,i)
10741 rdt(3,2,i)= rt(3,1,i)
10745 ! derivatives in phi
10751 drt(2,1,i)= rt(3,1,i)
10752 drt(2,2,i)= rt(3,2,i)
10753 drt(2,3,i)= rt(3,3,i)
10754 drt(3,1,i)=-rt(2,1,i)
10755 drt(3,2,i)=-rt(2,2,i)
10756 drt(3,3,i)=-rt(2,3,i)
10759 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
10765 temp(k,l)=rt(k,l,i)
10770 fromto(k,l,ind)=temp(k,l)
10779 dpkl=dpkl+temp(k,m)*rt(m,l,j)
10782 fromto(k,l,ind)=dpkl
10793 ! Calculate derivatives.
10799 ! Derivatives of DC(i+1) in theta(i+2)
10805 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
10808 prordt(j,k,i)=dp(j,k)
10811 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
10814 ! Derivatives of SC(i+1) in theta(i+2)
10816 xx1(1)=-0.5D0*xloc(2,i+1)
10817 xx1(2)= 0.5D0*xloc(1,i+1)
10821 xj=xj+r(j,k,i)*xx1(k)
10828 rj=rj+prod(j,k,i)*xx(k)
10833 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
10834 ! than the other off-diagonal derivatives.
10839 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
10841 dxdv(j,ind1+1)=dxoiij
10843 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
10845 ! Derivatives of DC(i+1) in phi(i+2)
10851 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
10854 prodrt(j,k,i)=dp(j,k)
10856 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
10859 ! Derivatives of SC(i+1) in phi(i+2)
10862 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
10863 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
10867 rj=rj+prod(j,k,i)*xx(k)
10872 ! Derivatives of SC(i+1) in phi(i+3).
10877 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
10879 dxdv(j+3,ind1+1)=dxoiij
10882 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
10883 ! theta(nres) and phi(i+3) thru phi(nres).
10887 ind=indmat(i+1,j+1)
10888 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
10893 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
10898 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
10899 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
10900 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
10901 ! Derivatives of virtual-bond vectors in theta
10903 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
10905 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
10906 ! Derivatives of SC vectors in theta
10910 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
10912 dxdv(k,ind1+1)=dxoijk
10915 !--- Calculate the derivatives in phi
10921 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
10927 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
10932 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
10934 dxdv(k+3,ind1+1)=dxoijk
10939 ! Derivatives in alpha and omega:
10942 ! dsci=dsc(itype(i))
10947 if(alphi.ne.alphi) alphi=100.0
10948 if(omegi.ne.omegi) omegi=-100.0
10953 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
10954 cosalphi=dcos(alphi)
10955 sinalphi=dsin(alphi)
10956 cosomegi=dcos(omegi)
10957 sinomegi=dsin(omegi)
10958 temp(1,1)=-dsci*sinalphi
10959 temp(2,1)= dsci*cosalphi*cosomegi
10960 temp(3,1)=-dsci*cosalphi*sinomegi
10962 temp(2,2)=-dsci*sinalphi*sinomegi
10963 temp(3,2)=-dsci*sinalphi*cosomegi
10964 theta2=pi-0.5D0*theta(i+1)
10968 !d print *,((temp(l,k),l=1,3),k=1,2)
10972 xxp= xp*cost2+yp*sint2
10973 yyp=-xp*sint2+yp*cost2
10976 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
10977 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
10981 dj=dj+prod(k,l,i-1)*xx(l)
10989 end subroutine cartder
10990 !-----------------------------------------------------------------------------
10992 !-----------------------------------------------------------------------------
10993 subroutine check_cartgrad
10994 ! Check the gradient of Cartesian coordinates in internal coordinates.
10995 ! implicit real*8 (a-h,o-z)
10996 ! include 'DIMENSIONS'
10997 ! include 'COMMON.IOUNITS'
10998 ! include 'COMMON.VAR'
10999 ! include 'COMMON.CHAIN'
11000 ! include 'COMMON.GEO'
11001 ! include 'COMMON.LOCAL'
11002 ! include 'COMMON.DERIV'
11003 real(kind=8),dimension(6,nres) :: temp
11004 real(kind=8),dimension(3) :: xx,gg
11005 integer :: i,k,j,ii
11006 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
11007 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11009 ! Check the gradient of the virtual-bond and SC vectors in the internal
11015 write (iout,'(a)') '**************** dx/dalpha'
11019 alph(i)=alph(i)+aincr
11021 temp(k,i)=dc(k,nres+i)
11025 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11026 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
11028 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11029 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
11035 write (iout,'(a)') '**************** dx/domega'
11039 omeg(i)=omeg(i)+aincr
11041 temp(k,i)=dc(k,nres+i)
11045 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11046 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
11047 (aincr*dabs(dxds(k+3,i))+aincr))
11049 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11050 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
11056 write (iout,'(a)') '**************** dx/dtheta'
11060 theta(i)=theta(i)+aincr
11063 temp(k,j)=dc(k,nres+j)
11069 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
11071 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11072 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
11073 (aincr*dabs(dxdv(k,ii))+aincr))
11075 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11076 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
11083 write (iout,'(a)') '***************** dx/dphi'
11086 phi(i)=phi(i)+aincr
11089 temp(k,j)=dc(k,nres+j)
11097 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11098 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
11099 (aincr*dabs(dxdv(k+3,ii))+aincr))
11101 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11102 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11105 phi(i)=phi(i)-aincr
11108 write (iout,'(a)') '****************** ddc/dtheta'
11111 theta(i+2)=thet+aincr
11122 gg(k)=(dc(k,j)-temp(k,j))/aincr
11123 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
11124 (aincr*dabs(dcdv(k,ii))+aincr))
11126 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11127 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
11137 write (iout,'(a)') '******************* ddc/dphi'
11140 phi(i+3)=phii+aincr
11151 gg(k)=(dc(k,j)-temp(k,j))/aincr
11152 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
11153 (aincr*dabs(dcdv(k+3,ii))+aincr))
11155 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11156 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11167 end subroutine check_cartgrad
11168 !-----------------------------------------------------------------------------
11169 subroutine check_ecart
11170 ! Check the gradient of the energy in Cartesian coordinates.
11171 ! implicit real*8 (a-h,o-z)
11172 ! include 'DIMENSIONS'
11173 ! include 'COMMON.CHAIN'
11174 ! include 'COMMON.DERIV'
11175 ! include 'COMMON.IOUNITS'
11176 ! include 'COMMON.VAR'
11177 ! include 'COMMON.CONTACTS'
11179 !el integer :: icall
11180 !el common /srutu/ icall
11181 real(kind=8),dimension(6) :: ggg
11182 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11183 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11184 real(kind=8),dimension(6,nres) :: grad_s
11185 real(kind=8),dimension(0:n_ene) :: energia,energia1
11186 integer :: uiparm(1)
11187 real(kind=8) :: urparm(1)
11189 integer :: nf,i,j,k
11190 real(kind=8) :: aincr,etot,etot1
11196 print '(a)','CG processor',me,' calling CHECK_CART.',aincr
11199 call geom_to_var(nvar,x)
11200 call etotal(energia)
11202 !el call enerprint(energia)
11203 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
11206 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11210 grad_s(j,i)=gradc(j,i,icg)
11211 grad_s(j+3,i)=gradx(j,i,icg)
11215 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11220 ddx(j)=dc(j,i+nres)
11223 dc(j,i)=dc(j,i)+aincr
11225 c(j,k)=c(j,k)+aincr
11226 c(j,k+nres)=c(j,k+nres)+aincr
11228 call etotal(energia1)
11230 ggg(j)=(etot1-etot)/aincr
11233 c(j,k)=c(j,k)-aincr
11234 c(j,k+nres)=c(j,k+nres)-aincr
11238 c(j,i+nres)=c(j,i+nres)+aincr
11239 dc(j,i+nres)=dc(j,i+nres)+aincr
11240 call etotal(energia1)
11242 ggg(j+3)=(etot1-etot)/aincr
11244 dc(j,i+nres)=ddx(j)
11246 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
11247 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
11250 end subroutine check_ecart
11252 !-----------------------------------------------------------------------------
11253 subroutine check_ecartint
11254 ! Check the gradient of the energy in Cartesian coordinates.
11255 use io_base, only: intout
11256 ! implicit real*8 (a-h,o-z)
11257 ! include 'DIMENSIONS'
11258 ! include 'COMMON.CONTROL'
11259 ! include 'COMMON.CHAIN'
11260 ! include 'COMMON.DERIV'
11261 ! include 'COMMON.IOUNITS'
11262 ! include 'COMMON.VAR'
11263 ! include 'COMMON.CONTACTS'
11264 ! include 'COMMON.MD'
11265 ! include 'COMMON.LOCAL'
11266 ! include 'COMMON.SPLITELE'
11268 !el integer :: icall
11269 !el common /srutu/ icall
11270 real(kind=8),dimension(6) :: ggg,ggg1
11271 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
11272 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11273 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
11274 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11275 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11276 real(kind=8),dimension(0:n_ene) :: energia,energia1
11277 integer :: uiparm(1)
11278 real(kind=8) :: urparm(1)
11280 integer :: i,j,k,nf
11281 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
11289 ! call intcartderiv
11290 ! call checkintcartgrad
11293 write(iout,*) 'Calling CHECK_ECARTINT.'
11296 write (iout,*) "Before geom_to_var"
11297 call geom_to_var(nvar,x)
11298 write (iout,*) "after geom_to_var"
11299 write (iout,*) "split_ene ",split_ene
11301 if (.not.split_ene) then
11302 write(iout,*) 'Calling CHECK_ECARTINT if'
11303 call etotal(energia)
11304 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11306 write (iout,*) "etot",etot
11308 !el call enerprint(energia)
11309 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11311 write (iout,*) "enter cartgrad"
11314 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11315 write (iout,*) "exit cartgrad"
11319 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11322 grad_s(j,0)=gcart(j,0)
11324 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11327 grad_s(j,i)=gcart(j,i)
11328 grad_s(j+3,i)=gxcart(j,i)
11332 write(iout,*) 'Calling CHECK_ECARTIN else.'
11333 !- split gradient check
11335 call etotal_long(energia)
11336 !el call enerprint(energia)
11338 write (iout,*) "enter cartgrad"
11341 write (iout,*) "exit cartgrad"
11344 write (iout,*) "longrange grad"
11346 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11347 (gxcart(j,i),j=1,3)
11350 grad_s(j,0)=gcart(j,0)
11354 grad_s(j,i)=gcart(j,i)
11355 grad_s(j+3,i)=gxcart(j,i)
11359 call etotal_short(energia)
11360 !el call enerprint(energia)
11362 write (iout,*) "enter cartgrad"
11365 write (iout,*) "exit cartgrad"
11368 write (iout,*) "shortrange grad"
11370 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11371 (gxcart(j,i),j=1,3)
11374 grad_s1(j,0)=gcart(j,0)
11378 grad_s1(j,i)=gcart(j,i)
11379 grad_s1(j+3,i)=gxcart(j,i)
11383 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11387 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
11388 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
11391 dcnorm_safe1(j)=dc_norm(j,i-1)
11392 dcnorm_safe2(j)=dc_norm(j,i)
11393 dxnorm_safe(j)=dc_norm(j,i+nres)
11396 c(j,i)=ddc(j)+aincr
11397 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
11398 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
11399 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11400 dc(j,i)=c(j,i+1)-c(j,i)
11401 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11402 call int_from_cart1(.false.)
11403 if (.not.split_ene) then
11404 call etotal(energia1)
11406 write (iout,*) "ij",i,j," etot1",etot1
11409 call etotal_long(energia1)
11411 call etotal_short(energia1)
11414 !- end split gradient
11415 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11416 c(j,i)=ddc(j)-aincr
11417 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
11418 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
11419 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11420 dc(j,i)=c(j,i+1)-c(j,i)
11421 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11422 call int_from_cart1(.false.)
11423 if (.not.split_ene) then
11424 call etotal(energia1)
11426 write (iout,*) "ij",i,j," etot2",etot2
11427 ggg(j)=(etot1-etot2)/(2*aincr)
11430 call etotal_long(energia1)
11432 ggg(j)=(etot11-etot21)/(2*aincr)
11433 call etotal_short(energia1)
11435 ggg1(j)=(etot12-etot22)/(2*aincr)
11436 !- end split gradient
11437 ! write (iout,*) "etot21",etot21," etot22",etot22
11439 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11441 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
11442 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
11443 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11444 dc(j,i)=c(j,i+1)-c(j,i)
11445 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11446 dc_norm(j,i-1)=dcnorm_safe1(j)
11447 dc_norm(j,i)=dcnorm_safe2(j)
11448 dc_norm(j,i+nres)=dxnorm_safe(j)
11451 c(j,i+nres)=ddx(j)+aincr
11452 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11453 call int_from_cart1(.false.)
11454 if (.not.split_ene) then
11455 call etotal(energia1)
11459 call etotal_long(energia1)
11461 call etotal_short(energia1)
11464 !- end split gradient
11465 c(j,i+nres)=ddx(j)-aincr
11466 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11467 call int_from_cart1(.false.)
11468 if (.not.split_ene) then
11469 call etotal(energia1)
11471 ggg(j+3)=(etot1-etot2)/(2*aincr)
11474 call etotal_long(energia1)
11476 ggg(j+3)=(etot11-etot21)/(2*aincr)
11477 call etotal_short(energia1)
11479 ggg1(j+3)=(etot12-etot22)/(2*aincr)
11480 !- end split gradient
11482 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11484 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11485 dc_norm(j,i+nres)=dxnorm_safe(j)
11486 call int_from_cart1(.false.)
11488 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11489 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
11490 if (split_ene) then
11491 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11492 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
11494 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11495 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
11496 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
11500 end subroutine check_ecartint
11502 !-----------------------------------------------------------------------------
11503 subroutine check_ecartint
11504 ! Check the gradient of the energy in Cartesian coordinates.
11505 use io_base, only: intout
11506 ! implicit real*8 (a-h,o-z)
11507 ! include 'DIMENSIONS'
11508 ! include 'COMMON.CONTROL'
11509 ! include 'COMMON.CHAIN'
11510 ! include 'COMMON.DERIV'
11511 ! include 'COMMON.IOUNITS'
11512 ! include 'COMMON.VAR'
11513 ! include 'COMMON.CONTACTS'
11514 ! include 'COMMON.MD'
11515 ! include 'COMMON.LOCAL'
11516 ! include 'COMMON.SPLITELE'
11518 !el integer :: icall
11519 !el common /srutu/ icall
11520 real(kind=8),dimension(6) :: ggg,ggg1
11521 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11522 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11523 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
11524 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11525 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11526 real(kind=8),dimension(0:n_ene) :: energia,energia1
11527 integer :: uiparm(1)
11528 real(kind=8) :: urparm(1)
11530 integer :: i,j,k,nf
11531 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
11539 ! call intcartderiv
11540 ! call checkintcartgrad
11543 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
11546 call geom_to_var(nvar,x)
11547 if (.not.split_ene) then
11548 call etotal(energia)
11550 !el call enerprint(energia)
11552 write (iout,*) "enter cartgrad"
11555 write (iout,*) "exit cartgrad"
11559 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11562 grad_s(j,0)=gcart(j,0)
11566 grad_s(j,i)=gcart(j,i)
11567 grad_s(j+3,i)=gxcart(j,i)
11571 !- split gradient check
11573 call etotal_long(energia)
11574 !el call enerprint(energia)
11576 write (iout,*) "enter cartgrad"
11579 write (iout,*) "exit cartgrad"
11582 write (iout,*) "longrange grad"
11584 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11585 (gxcart(j,i),j=1,3)
11588 grad_s(j,0)=gcart(j,0)
11592 grad_s(j,i)=gcart(j,i)
11593 grad_s(j+3,i)=gxcart(j,i)
11597 call etotal_short(energia)
11598 !el call enerprint(energia)
11600 write (iout,*) "enter cartgrad"
11603 write (iout,*) "exit cartgrad"
11606 write (iout,*) "shortrange grad"
11608 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11609 (gxcart(j,i),j=1,3)
11612 grad_s1(j,0)=gcart(j,0)
11616 grad_s1(j,i)=gcart(j,i)
11617 grad_s1(j+3,i)=gxcart(j,i)
11621 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11626 ddx(j)=dc(j,i+nres)
11628 dcnorm_safe(k)=dc_norm(k,i)
11629 dxnorm_safe(k)=dc_norm(k,i+nres)
11633 dc(j,i)=ddc(j)+aincr
11634 call chainbuild_cart
11636 ! Broadcast the order to compute internal coordinates to the slaves.
11637 ! if (nfgtasks.gt.1)
11638 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
11640 ! call int_from_cart1(.false.)
11641 if (.not.split_ene) then
11642 call etotal(energia1)
11646 call etotal_long(energia1)
11648 call etotal_short(energia1)
11650 ! write (iout,*) "etot11",etot11," etot12",etot12
11652 !- end split gradient
11653 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11654 dc(j,i)=ddc(j)-aincr
11655 call chainbuild_cart
11656 ! call int_from_cart1(.false.)
11657 if (.not.split_ene) then
11658 call etotal(energia1)
11660 ggg(j)=(etot1-etot2)/(2*aincr)
11663 call etotal_long(energia1)
11665 ggg(j)=(etot11-etot21)/(2*aincr)
11666 call etotal_short(energia1)
11668 ggg1(j)=(etot12-etot22)/(2*aincr)
11669 !- end split gradient
11670 ! write (iout,*) "etot21",etot21," etot22",etot22
11672 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11674 call chainbuild_cart
11677 dc(j,i+nres)=ddx(j)+aincr
11678 call chainbuild_cart
11679 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
11680 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
11681 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
11682 ! write (iout,*) "dxnormnorm",dsqrt(
11683 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
11684 ! write (iout,*) "dxnormnormsafe",dsqrt(
11685 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
11687 if (.not.split_ene) then
11688 call etotal(energia1)
11692 call etotal_long(energia1)
11694 call etotal_short(energia1)
11697 !- end split gradient
11698 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11699 dc(j,i+nres)=ddx(j)-aincr
11700 call chainbuild_cart
11701 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
11702 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
11703 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
11705 ! write (iout,*) "dxnormnorm",dsqrt(
11706 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
11707 ! write (iout,*) "dxnormnormsafe",dsqrt(
11708 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
11709 if (.not.split_ene) then
11710 call etotal(energia1)
11712 ggg(j+3)=(etot1-etot2)/(2*aincr)
11715 call etotal_long(energia1)
11717 ggg(j+3)=(etot11-etot21)/(2*aincr)
11718 call etotal_short(energia1)
11720 ggg1(j+3)=(etot12-etot22)/(2*aincr)
11721 !- end split gradient
11723 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11724 dc(j,i+nres)=ddx(j)
11725 call chainbuild_cart
11727 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11728 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
11729 if (split_ene) then
11730 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11731 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
11733 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11734 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
11735 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
11739 end subroutine check_ecartint
11741 !-----------------------------------------------------------------------------
11742 subroutine check_eint
11743 ! Check the gradient of energy in internal coordinates.
11744 ! implicit real*8 (a-h,o-z)
11745 ! include 'DIMENSIONS'
11746 ! include 'COMMON.CHAIN'
11747 ! include 'COMMON.DERIV'
11748 ! include 'COMMON.IOUNITS'
11749 ! include 'COMMON.VAR'
11750 ! include 'COMMON.GEO'
11752 !el integer :: icall
11753 !el common /srutu/ icall
11754 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
11755 integer :: uiparm(1)
11756 real(kind=8) :: urparm(1)
11757 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
11758 character(len=6) :: key
11761 real(kind=8) :: xi,aincr,etot,etot1,etot2
11764 print '(a)','Calling CHECK_INT.'
11768 call geom_to_var(nvar,x)
11769 call var_to_geom(nvar,x)
11773 call etotal(energia)
11775 !el call enerprint(energia)
11778 if (MyID.ne.BossID) then
11779 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
11787 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
11788 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
11789 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
11793 x(i)=xi-0.5D0*aincr
11794 call var_to_geom(nvar,x)
11796 call etotal(energia1)
11798 x(i)=xi+0.5D0*aincr
11799 call var_to_geom(nvar,x)
11801 call etotal(energia2)
11803 gg(i)=(etot2-etot1)/aincr
11804 write (iout,*) i,etot1,etot2
11807 write (iout,'(/2a)')' Variable Numerical Analytical',&
11810 if (i.le.nphi) then
11813 else if (i.le.nphi+ntheta) then
11816 else if (i.le.nphi+ntheta+nside) then
11820 ii=i-(nphi+ntheta+nside)
11823 write (iout,'(i3,a,i3,3(1pd16.6))') &
11824 i,key,ii,gg(i),gana(i),&
11825 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
11828 end subroutine check_eint
11829 !-----------------------------------------------------------------------------
11831 !-----------------------------------------------------------------------------
11832 subroutine Econstr_back
11833 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
11834 ! implicit real*8 (a-h,o-z)
11835 ! include 'DIMENSIONS'
11836 ! include 'COMMON.CONTROL'
11837 ! include 'COMMON.VAR'
11838 ! include 'COMMON.MD'
11841 ! include 'COMMON.LANGEVIN'
11843 ! include 'COMMON.LANGEVIN.lang0'
11845 ! include 'COMMON.CHAIN'
11846 ! include 'COMMON.DERIV'
11847 ! include 'COMMON.GEO'
11848 ! include 'COMMON.LOCAL'
11849 ! include 'COMMON.INTERACT'
11850 ! include 'COMMON.IOUNITS'
11851 ! include 'COMMON.NAMES'
11852 ! include 'COMMON.TIME1'
11853 integer :: i,j,ii,k
11854 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
11856 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
11857 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
11858 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
11865 duscdiff(j,i)=0.0d0
11866 duscdiffx(j,i)=0.0d0
11870 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
11872 ! Deviations from theta angles
11875 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
11876 dtheta_i=theta(j)-thetaref(j)
11877 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
11878 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
11880 utheta(i)=utheta_i/(ii-1)
11882 ! Deviations from gamma angles
11885 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
11886 dgamma_i=pinorm(phi(j)-phiref(j))
11887 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
11888 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
11889 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
11890 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
11892 ugamma(i)=ugamma_i/(ii-2)
11894 ! Deviations from local SC geometry
11897 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
11898 dxx=xxtab(j)-xxref(j)
11899 dyy=yytab(j)-yyref(j)
11900 dzz=zztab(j)-zzref(j)
11901 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
11903 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
11904 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
11906 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
11907 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
11909 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
11910 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
11913 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
11914 ! & xxref(j),yyref(j),zzref(j)
11916 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
11917 ! write (iout,*) i," uscdiff",uscdiff(i)
11919 ! Put together deviations from local geometry
11921 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
11922 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
11923 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
11924 ! & " uconst_back",uconst_back
11925 utheta(i)=dsqrt(utheta(i))
11926 ugamma(i)=dsqrt(ugamma(i))
11927 uscdiff(i)=dsqrt(uscdiff(i))
11930 end subroutine Econstr_back
11931 !-----------------------------------------------------------------------------
11932 ! energy_p_new-sep_barrier.F
11933 !-----------------------------------------------------------------------------
11934 real(kind=8) function sscale(r)
11935 ! include "COMMON.SPLITELE"
11936 real(kind=8) :: r,gamm
11937 if(r.lt.r_cut-rlamb) then
11939 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
11940 gamm=(r-(r_cut-rlamb))/rlamb
11941 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
11946 end function sscale
11947 real(kind=8) function sscale_grad(r)
11948 ! include "COMMON.SPLITELE"
11949 real(kind=8) :: r,gamm
11950 if(r.lt.r_cut-rlamb) then
11952 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
11953 gamm=(r-(r_cut-rlamb))/rlamb
11954 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
11959 end function sscale_grad
11961 !!!!!!!!!! PBCSCALE
11962 real(kind=8) function sscale_ele(r)
11963 ! include "COMMON.SPLITELE"
11964 real(kind=8) :: r,gamm
11965 if(r.lt.r_cut_ele-rlamb_ele) then
11967 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
11968 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
11969 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
11974 end function sscale_ele
11976 real(kind=8) function sscagrad_ele(r)
11977 real(kind=8) :: r,gamm
11978 ! include "COMMON.SPLITELE"
11979 if(r.lt.r_cut_ele-rlamb_ele) then
11981 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
11982 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
11983 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
11988 end function sscagrad_ele
11989 real(kind=8) function sscalelip(r)
11990 real(kind=8) r,gamm
11991 sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
11993 end function sscalelip
11994 !C-----------------------------------------------------------------------
11995 real(kind=8) function sscagradlip(r)
11996 real(kind=8) r,gamm
11997 sscagradlip=r*(6.0d0*r-6.0d0)
11999 end function sscagradlip
12002 !-----------------------------------------------------------------------------
12003 subroutine elj_long(evdw)
12005 ! This subroutine calculates the interaction energy of nonbonded side chains
12006 ! assuming the LJ potential of interaction.
12008 ! implicit real*8 (a-h,o-z)
12009 ! include 'DIMENSIONS'
12010 ! include 'COMMON.GEO'
12011 ! include 'COMMON.VAR'
12012 ! include 'COMMON.LOCAL'
12013 ! include 'COMMON.CHAIN'
12014 ! include 'COMMON.DERIV'
12015 ! include 'COMMON.INTERACT'
12016 ! include 'COMMON.TORSION'
12017 ! include 'COMMON.SBRIDGE'
12018 ! include 'COMMON.NAMES'
12019 ! include 'COMMON.IOUNITS'
12020 ! include 'COMMON.CONTACTS'
12021 real(kind=8),parameter :: accur=1.0d-10
12022 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12023 !el local variables
12024 integer :: i,iint,j,k,itypi,itypi1,itypj
12025 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12026 real(kind=8) :: e1,e2,evdwij,evdw
12027 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12029 do i=iatsc_s,iatsc_e
12031 if (itypi.eq.ntyp1) cycle
12037 ! Calculate SC interaction energy.
12039 do iint=1,nint_gr(i)
12040 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12041 !d & 'iend=',iend(i,iint)
12042 do j=istart(i,iint),iend(i,iint)
12044 if (itypj.eq.ntyp1) cycle
12048 rij=xj*xj+yj*yj+zj*zj
12049 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12050 if (sss.lt.1.0d0) then
12052 eps0ij=eps(itypi,itypj)
12054 e1=fac*fac*aa_aq(itypi,itypj)
12055 e2=fac*bb_aq(itypi,itypj)
12057 evdw=evdw+(1.0d0-sss)*evdwij
12059 ! Calculate the components of the gradient in DC and X
12061 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
12066 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12067 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12068 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12069 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12077 gvdwc(j,i)=expon*gvdwc(j,i)
12078 gvdwx(j,i)=expon*gvdwx(j,i)
12081 !******************************************************************************
12085 ! To save time, the factor of EXPON has been extracted from ALL components
12086 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12089 !******************************************************************************
12091 end subroutine elj_long
12092 !-----------------------------------------------------------------------------
12093 subroutine elj_short(evdw)
12095 ! This subroutine calculates the interaction energy of nonbonded side chains
12096 ! assuming the LJ potential of interaction.
12098 ! implicit real*8 (a-h,o-z)
12099 ! include 'DIMENSIONS'
12100 ! include 'COMMON.GEO'
12101 ! include 'COMMON.VAR'
12102 ! include 'COMMON.LOCAL'
12103 ! include 'COMMON.CHAIN'
12104 ! include 'COMMON.DERIV'
12105 ! include 'COMMON.INTERACT'
12106 ! include 'COMMON.TORSION'
12107 ! include 'COMMON.SBRIDGE'
12108 ! include 'COMMON.NAMES'
12109 ! include 'COMMON.IOUNITS'
12110 ! include 'COMMON.CONTACTS'
12111 real(kind=8),parameter :: accur=1.0d-10
12112 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12113 !el local variables
12114 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
12115 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12116 real(kind=8) :: e1,e2,evdwij,evdw
12117 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12119 do i=iatsc_s,iatsc_e
12121 if (itypi.eq.ntyp1) cycle
12129 ! Calculate SC interaction energy.
12131 do iint=1,nint_gr(i)
12132 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12133 !d & 'iend=',iend(i,iint)
12134 do j=istart(i,iint),iend(i,iint)
12136 if (itypj.eq.ntyp1) cycle
12140 ! Change 12/1/95 to calculate four-body interactions
12141 rij=xj*xj+yj*yj+zj*zj
12142 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12143 if (sss.gt.0.0d0) then
12145 eps0ij=eps(itypi,itypj)
12147 e1=fac*fac*aa_aq(itypi,itypj)
12148 e2=fac*bb_aq(itypi,itypj)
12150 evdw=evdw+sss*evdwij
12152 ! Calculate the components of the gradient in DC and X
12154 fac=-rrij*(e1+evdwij)*sss
12159 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12160 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12161 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12162 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12170 gvdwc(j,i)=expon*gvdwc(j,i)
12171 gvdwx(j,i)=expon*gvdwx(j,i)
12174 !******************************************************************************
12178 ! To save time, the factor of EXPON has been extracted from ALL components
12179 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12182 !******************************************************************************
12184 end subroutine elj_short
12185 !-----------------------------------------------------------------------------
12186 subroutine eljk_long(evdw)
12188 ! This subroutine calculates the interaction energy of nonbonded side chains
12189 ! assuming the LJK potential of interaction.
12191 ! implicit real*8 (a-h,o-z)
12192 ! include 'DIMENSIONS'
12193 ! include 'COMMON.GEO'
12194 ! include 'COMMON.VAR'
12195 ! include 'COMMON.LOCAL'
12196 ! include 'COMMON.CHAIN'
12197 ! include 'COMMON.DERIV'
12198 ! include 'COMMON.INTERACT'
12199 ! include 'COMMON.IOUNITS'
12200 ! include 'COMMON.NAMES'
12201 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12203 !el local variables
12204 integer :: i,iint,j,k,itypi,itypi1,itypj
12205 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12206 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12207 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12209 do i=iatsc_s,iatsc_e
12211 if (itypi.eq.ntyp1) cycle
12217 ! Calculate SC interaction energy.
12219 do iint=1,nint_gr(i)
12220 do j=istart(i,iint),iend(i,iint)
12222 if (itypj.eq.ntyp1) cycle
12226 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12227 fac_augm=rrij**expon
12228 e_augm=augm(itypi,itypj)*fac_augm
12229 r_inv_ij=dsqrt(rrij)
12231 sss=sscale(rij/sigma(itypi,itypj))
12232 if (sss.lt.1.0d0) then
12233 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12234 fac=r_shift_inv**expon
12235 e1=fac*fac*aa_aq(itypi,itypj)
12236 e2=fac*bb_aq(itypi,itypj)
12237 evdwij=e_augm+e1+e2
12238 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12239 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12240 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12241 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
12242 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12243 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12244 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12245 evdw=evdw+(1.0d0-sss)*evdwij
12247 ! Calculate the components of the gradient in DC and X
12249 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12250 fac=fac*(1.0d0-sss)
12255 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12256 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12257 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12258 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12266 gvdwc(j,i)=expon*gvdwc(j,i)
12267 gvdwx(j,i)=expon*gvdwx(j,i)
12271 end subroutine eljk_long
12272 !-----------------------------------------------------------------------------
12273 subroutine eljk_short(evdw)
12275 ! This subroutine calculates the interaction energy of nonbonded side chains
12276 ! assuming the LJK potential of interaction.
12278 ! implicit real*8 (a-h,o-z)
12279 ! include 'DIMENSIONS'
12280 ! include 'COMMON.GEO'
12281 ! include 'COMMON.VAR'
12282 ! include 'COMMON.LOCAL'
12283 ! include 'COMMON.CHAIN'
12284 ! include 'COMMON.DERIV'
12285 ! include 'COMMON.INTERACT'
12286 ! include 'COMMON.IOUNITS'
12287 ! include 'COMMON.NAMES'
12288 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12290 !el local variables
12291 integer :: i,iint,j,k,itypi,itypi1,itypj
12292 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12293 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12294 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12296 do i=iatsc_s,iatsc_e
12298 if (itypi.eq.ntyp1) cycle
12304 ! Calculate SC interaction energy.
12306 do iint=1,nint_gr(i)
12307 do j=istart(i,iint),iend(i,iint)
12309 if (itypj.eq.ntyp1) cycle
12313 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12314 fac_augm=rrij**expon
12315 e_augm=augm(itypi,itypj)*fac_augm
12316 r_inv_ij=dsqrt(rrij)
12318 sss=sscale(rij/sigma(itypi,itypj))
12319 if (sss.gt.0.0d0) then
12320 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12321 fac=r_shift_inv**expon
12322 e1=fac*fac*aa_aq(itypi,itypj)
12323 e2=fac*bb_aq(itypi,itypj)
12324 evdwij=e_augm+e1+e2
12325 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12326 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12327 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12328 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
12329 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12330 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12331 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12332 evdw=evdw+sss*evdwij
12334 ! Calculate the components of the gradient in DC and X
12336 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12342 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12343 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12344 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12345 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12353 gvdwc(j,i)=expon*gvdwc(j,i)
12354 gvdwx(j,i)=expon*gvdwx(j,i)
12358 end subroutine eljk_short
12359 !-----------------------------------------------------------------------------
12360 subroutine ebp_long(evdw)
12362 ! This subroutine calculates the interaction energy of nonbonded side chains
12363 ! assuming the Berne-Pechukas potential of interaction.
12366 ! implicit real*8 (a-h,o-z)
12367 ! include 'DIMENSIONS'
12368 ! include 'COMMON.GEO'
12369 ! include 'COMMON.VAR'
12370 ! include 'COMMON.LOCAL'
12371 ! include 'COMMON.CHAIN'
12372 ! include 'COMMON.DERIV'
12373 ! include 'COMMON.NAMES'
12374 ! include 'COMMON.INTERACT'
12375 ! include 'COMMON.IOUNITS'
12376 ! include 'COMMON.CALC'
12378 !el integer :: icall
12379 !el common /srutu/ icall
12380 ! double precision rrsave(maxdim)
12382 !el local variables
12383 integer :: iint,itypi,itypi1,itypj
12384 real(kind=8) :: rrij,xi,yi,zi,fac
12385 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
12387 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12389 ! if (icall.eq.0) then
12395 do i=iatsc_s,iatsc_e
12397 if (itypi.eq.ntyp1) cycle
12402 dxi=dc_norm(1,nres+i)
12403 dyi=dc_norm(2,nres+i)
12404 dzi=dc_norm(3,nres+i)
12405 ! dsci_inv=dsc_inv(itypi)
12406 dsci_inv=vbld_inv(i+nres)
12408 ! Calculate SC interaction energy.
12410 do iint=1,nint_gr(i)
12411 do j=istart(i,iint),iend(i,iint)
12414 if (itypj.eq.ntyp1) cycle
12415 ! dscj_inv=dsc_inv(itypj)
12416 dscj_inv=vbld_inv(j+nres)
12417 chi1=chi(itypi,itypj)
12418 chi2=chi(itypj,itypi)
12425 alf12=0.5D0*(alf1+alf2)
12429 dxj=dc_norm(1,nres+j)
12430 dyj=dc_norm(2,nres+j)
12431 dzj=dc_norm(3,nres+j)
12432 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12434 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12436 if (sss.lt.1.0d0) then
12438 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12440 ! Calculate whole angle-dependent part of epsilon and contributions
12441 ! to its derivatives
12442 fac=(rrij*sigsq)**expon2
12443 e1=fac*fac*aa_aq(itypi,itypj)
12444 e2=fac*bb_aq(itypi,itypj)
12445 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12446 eps2der=evdwij*eps3rt
12447 eps3der=evdwij*eps2rt
12448 evdwij=evdwij*eps2rt*eps3rt
12449 evdw=evdw+evdwij*(1.0d0-sss)
12451 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12452 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12453 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12454 !d & restyp(itypi),i,restyp(itypj),j,
12455 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12456 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12457 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12460 ! Calculate gradient components.
12461 e1=e1*eps1*eps2rt**2*eps3rt**2
12462 fac=-expon*(e1+evdwij)
12465 ! Calculate radial part of the gradient
12469 ! Calculate the angular part of the gradient and sum add the contributions
12470 ! to the appropriate components of the Cartesian gradient.
12471 call sc_grad_scale(1.0d0-sss)
12478 end subroutine ebp_long
12479 !-----------------------------------------------------------------------------
12480 subroutine ebp_short(evdw)
12482 ! This subroutine calculates the interaction energy of nonbonded side chains
12483 ! assuming the Berne-Pechukas potential of interaction.
12486 ! implicit real*8 (a-h,o-z)
12487 ! include 'DIMENSIONS'
12488 ! include 'COMMON.GEO'
12489 ! include 'COMMON.VAR'
12490 ! include 'COMMON.LOCAL'
12491 ! include 'COMMON.CHAIN'
12492 ! include 'COMMON.DERIV'
12493 ! include 'COMMON.NAMES'
12494 ! include 'COMMON.INTERACT'
12495 ! include 'COMMON.IOUNITS'
12496 ! include 'COMMON.CALC'
12498 !el integer :: icall
12499 !el common /srutu/ icall
12500 ! double precision rrsave(maxdim)
12502 !el local variables
12503 integer :: iint,itypi,itypi1,itypj
12504 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
12505 real(kind=8) :: sss,e1,e2,evdw
12507 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12509 ! if (icall.eq.0) then
12515 do i=iatsc_s,iatsc_e
12517 if (itypi.eq.ntyp1) cycle
12522 dxi=dc_norm(1,nres+i)
12523 dyi=dc_norm(2,nres+i)
12524 dzi=dc_norm(3,nres+i)
12525 ! dsci_inv=dsc_inv(itypi)
12526 dsci_inv=vbld_inv(i+nres)
12528 ! Calculate SC interaction energy.
12530 do iint=1,nint_gr(i)
12531 do j=istart(i,iint),iend(i,iint)
12534 if (itypj.eq.ntyp1) cycle
12535 ! dscj_inv=dsc_inv(itypj)
12536 dscj_inv=vbld_inv(j+nres)
12537 chi1=chi(itypi,itypj)
12538 chi2=chi(itypj,itypi)
12545 alf12=0.5D0*(alf1+alf2)
12549 dxj=dc_norm(1,nres+j)
12550 dyj=dc_norm(2,nres+j)
12551 dzj=dc_norm(3,nres+j)
12552 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12554 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12556 if (sss.gt.0.0d0) then
12558 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12560 ! Calculate whole angle-dependent part of epsilon and contributions
12561 ! to its derivatives
12562 fac=(rrij*sigsq)**expon2
12563 e1=fac*fac*aa_aq(itypi,itypj)
12564 e2=fac*bb_aq(itypi,itypj)
12565 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12566 eps2der=evdwij*eps3rt
12567 eps3der=evdwij*eps2rt
12568 evdwij=evdwij*eps2rt*eps3rt
12569 evdw=evdw+evdwij*sss
12571 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12572 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12573 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12574 !d & restyp(itypi),i,restyp(itypj),j,
12575 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12576 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12577 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12580 ! Calculate gradient components.
12581 e1=e1*eps1*eps2rt**2*eps3rt**2
12582 fac=-expon*(e1+evdwij)
12585 ! Calculate radial part of the gradient
12589 ! Calculate the angular part of the gradient and sum add the contributions
12590 ! to the appropriate components of the Cartesian gradient.
12591 call sc_grad_scale(sss)
12598 end subroutine ebp_short
12599 !-----------------------------------------------------------------------------
12600 subroutine egb_long(evdw)
12602 ! This subroutine calculates the interaction energy of nonbonded side chains
12603 ! assuming the Gay-Berne potential of interaction.
12606 ! implicit real*8 (a-h,o-z)
12607 ! include 'DIMENSIONS'
12608 ! include 'COMMON.GEO'
12609 ! include 'COMMON.VAR'
12610 ! include 'COMMON.LOCAL'
12611 ! include 'COMMON.CHAIN'
12612 ! include 'COMMON.DERIV'
12613 ! include 'COMMON.NAMES'
12614 ! include 'COMMON.INTERACT'
12615 ! include 'COMMON.IOUNITS'
12616 ! include 'COMMON.CALC'
12617 ! include 'COMMON.CONTROL'
12619 !el local variables
12620 integer :: iint,itypi,itypi1,itypj,subchap
12621 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
12622 real(kind=8) :: sss,e1,e2,evdw,sss_grad
12623 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
12624 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
12625 ssgradlipi,ssgradlipj
12629 !cccc energy_dec=.false.
12630 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
12633 ! if (icall.eq.0) lprn=.false.
12635 do i=iatsc_s,iatsc_e
12637 if (itypi.eq.ntyp1) cycle
12642 xi=mod(xi,boxxsize)
12643 if (xi.lt.0) xi=xi+boxxsize
12644 yi=mod(yi,boxysize)
12645 if (yi.lt.0) yi=yi+boxysize
12646 zi=mod(zi,boxzsize)
12647 if (zi.lt.0) zi=zi+boxzsize
12648 if ((zi.gt.bordlipbot) &
12649 .and.(zi.lt.bordliptop)) then
12650 !C the energy transfer exist
12651 if (zi.lt.buflipbot) then
12652 !C what fraction I am in
12654 ((zi-bordlipbot)/lipbufthick)
12655 !C lipbufthick is thickenes of lipid buffore
12656 sslipi=sscalelip(fracinbuf)
12657 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
12658 elseif (zi.gt.bufliptop) then
12659 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
12660 sslipi=sscalelip(fracinbuf)
12661 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
12671 dxi=dc_norm(1,nres+i)
12672 dyi=dc_norm(2,nres+i)
12673 dzi=dc_norm(3,nres+i)
12674 ! dsci_inv=dsc_inv(itypi)
12675 dsci_inv=vbld_inv(i+nres)
12676 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
12677 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
12679 ! Calculate SC interaction energy.
12681 do iint=1,nint_gr(i)
12682 do j=istart(i,iint),iend(i,iint)
12683 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
12684 call dyn_ssbond_ene(i,j,evdwij)
12686 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
12687 'evdw',i,j,evdwij,' ss'
12688 ! if (energy_dec) write (iout,*) &
12689 ! 'evdw',i,j,evdwij,' ss'
12693 if (itypj.eq.ntyp1) cycle
12694 ! dscj_inv=dsc_inv(itypj)
12695 dscj_inv=vbld_inv(j+nres)
12696 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
12697 ! & 1.0d0/vbld(j+nres)
12698 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
12699 sig0ij=sigma(itypi,itypj)
12700 chi1=chi(itypi,itypj)
12701 chi2=chi(itypj,itypi)
12708 alf12=0.5D0*(alf1+alf2)
12712 ! Searching for nearest neighbour
12713 xj=mod(xj,boxxsize)
12714 if (xj.lt.0) xj=xj+boxxsize
12715 yj=mod(yj,boxysize)
12716 if (yj.lt.0) yj=yj+boxysize
12717 zj=mod(zj,boxzsize)
12718 if (zj.lt.0) zj=zj+boxzsize
12719 if ((zj.gt.bordlipbot) &
12720 .and.(zj.lt.bordliptop)) then
12721 !C the energy transfer exist
12722 if (zj.lt.buflipbot) then
12723 !C what fraction I am in
12725 ((zj-bordlipbot)/lipbufthick)
12726 !C lipbufthick is thickenes of lipid buffore
12727 sslipj=sscalelip(fracinbuf)
12728 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
12729 elseif (zj.gt.bufliptop) then
12730 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
12731 sslipj=sscalelip(fracinbuf)
12732 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
12741 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
12742 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
12743 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
12744 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
12746 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
12754 xj=xj_safe+xshift*boxxsize
12755 yj=yj_safe+yshift*boxysize
12756 zj=zj_safe+zshift*boxzsize
12757 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
12758 if(dist_temp.lt.dist_init) then
12759 dist_init=dist_temp
12768 if (subchap.eq.1) then
12778 dxj=dc_norm(1,nres+j)
12779 dyj=dc_norm(2,nres+j)
12780 dzj=dc_norm(3,nres+j)
12781 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12783 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12784 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
12785 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
12786 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
12787 if (sss_ele_cut.le.0.0) cycle
12788 if (sss.lt.1.0d0) then
12790 ! Calculate angle-dependent terms of energy and contributions to their
12794 sig=sig0ij*dsqrt(sigsq)
12795 rij_shift=1.0D0/rij-sig+sig0ij
12796 ! for diagnostics; uncomment
12797 ! rij_shift=1.2*sig0ij
12798 ! I hate to put IF's in the loops, but here don't have another choice!!!!
12799 if (rij_shift.le.0.0D0) then
12801 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
12802 !d & restyp(itypi),i,restyp(itypj),j,
12803 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
12807 !---------------------------------------------------------------
12808 rij_shift=1.0D0/rij_shift
12809 fac=rij_shift**expon
12812 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12813 eps2der=evdwij*eps3rt
12814 eps3der=evdwij*eps2rt
12815 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
12816 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
12817 evdwij=evdwij*eps2rt*eps3rt
12818 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
12820 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12821 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12822 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
12823 restyp(itypi),i,restyp(itypj),j,&
12824 epsi,sigm,chi1,chi2,chip1,chip2,&
12825 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
12826 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
12830 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
12832 ! if (energy_dec) write (iout,*) &
12833 ! 'evdw',i,j,evdwij,"egb_long"
12835 ! Calculate gradient components.
12836 e1=e1*eps1*eps2rt**2*eps3rt**2
12837 fac=-expon*(e1+evdwij)*rij_shift
12840 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
12841 /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
12842 /sigmaii(itypi,itypj))
12844 ! Calculate the radial part of the gradient
12848 ! Calculate angular part of the gradient.
12849 call sc_grad_scale(1.0d0-sss)
12855 ! write (iout,*) "Number of loop steps in EGB:",ind
12856 !ccc energy_dec=.false.
12858 end subroutine egb_long
12859 !-----------------------------------------------------------------------------
12860 subroutine egb_short(evdw)
12862 ! This subroutine calculates the interaction energy of nonbonded side chains
12863 ! assuming the Gay-Berne potential of interaction.
12866 ! implicit real*8 (a-h,o-z)
12867 ! include 'DIMENSIONS'
12868 ! include 'COMMON.GEO'
12869 ! include 'COMMON.VAR'
12870 ! include 'COMMON.LOCAL'
12871 ! include 'COMMON.CHAIN'
12872 ! include 'COMMON.DERIV'
12873 ! include 'COMMON.NAMES'
12874 ! include 'COMMON.INTERACT'
12875 ! include 'COMMON.IOUNITS'
12876 ! include 'COMMON.CALC'
12877 ! include 'COMMON.CONTROL'
12879 !el local variables
12880 integer :: iint,itypi,itypi1,itypj,subchap
12881 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
12882 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
12883 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
12884 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
12885 ssgradlipi,ssgradlipj
12887 !cccc energy_dec=.false.
12888 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
12891 ! if (icall.eq.0) lprn=.false.
12893 do i=iatsc_s,iatsc_e
12895 if (itypi.eq.ntyp1) cycle
12900 xi=mod(xi,boxxsize)
12901 if (xi.lt.0) xi=xi+boxxsize
12902 yi=mod(yi,boxysize)
12903 if (yi.lt.0) yi=yi+boxysize
12904 zi=mod(zi,boxzsize)
12905 if (zi.lt.0) zi=zi+boxzsize
12906 if ((zi.gt.bordlipbot) &
12907 .and.(zi.lt.bordliptop)) then
12908 !C the energy transfer exist
12909 if (zi.lt.buflipbot) then
12910 !C what fraction I am in
12912 ((zi-bordlipbot)/lipbufthick)
12913 !C lipbufthick is thickenes of lipid buffore
12914 sslipi=sscalelip(fracinbuf)
12915 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
12916 elseif (zi.gt.bufliptop) then
12917 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
12918 sslipi=sscalelip(fracinbuf)
12919 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
12929 dxi=dc_norm(1,nres+i)
12930 dyi=dc_norm(2,nres+i)
12931 dzi=dc_norm(3,nres+i)
12932 ! dsci_inv=dsc_inv(itypi)
12933 dsci_inv=vbld_inv(i+nres)
12935 dxi=dc_norm(1,nres+i)
12936 dyi=dc_norm(2,nres+i)
12937 dzi=dc_norm(3,nres+i)
12938 ! dsci_inv=dsc_inv(itypi)
12939 dsci_inv=vbld_inv(i+nres)
12940 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
12941 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
12943 ! Calculate SC interaction energy.
12945 do iint=1,nint_gr(i)
12946 do j=istart(i,iint),iend(i,iint)
12947 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
12948 call dyn_ssbond_ene(i,j,evdwij)
12950 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
12951 'evdw',i,j,evdwij,' ss'
12952 ! if (energy_dec) write (iout,*) &
12953 ! 'evdw',i,j,evdwij,' ss'
12957 if (itypj.eq.ntyp1) cycle
12958 ! dscj_inv=dsc_inv(itypj)
12959 dscj_inv=vbld_inv(j+nres)
12960 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
12961 ! & 1.0d0/vbld(j+nres)
12962 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
12963 sig0ij=sigma(itypi,itypj)
12964 chi1=chi(itypi,itypj)
12965 chi2=chi(itypj,itypi)
12972 alf12=0.5D0*(alf1+alf2)
12973 ! xj=c(1,nres+j)-xi
12974 ! yj=c(2,nres+j)-yi
12975 ! zj=c(3,nres+j)-zi
12979 ! Searching for nearest neighbour
12980 xj=mod(xj,boxxsize)
12981 if (xj.lt.0) xj=xj+boxxsize
12982 yj=mod(yj,boxysize)
12983 if (yj.lt.0) yj=yj+boxysize
12984 zj=mod(zj,boxzsize)
12985 if (zj.lt.0) zj=zj+boxzsize
12986 if ((zj.gt.bordlipbot) &
12987 .and.(zj.lt.bordliptop)) then
12988 !C the energy transfer exist
12989 if (zj.lt.buflipbot) then
12990 !C what fraction I am in
12992 ((zj-bordlipbot)/lipbufthick)
12993 !C lipbufthick is thickenes of lipid buffore
12994 sslipj=sscalelip(fracinbuf)
12995 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
12996 elseif (zj.gt.bufliptop) then
12997 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
12998 sslipj=sscalelip(fracinbuf)
12999 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13008 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13009 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13010 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13011 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13013 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13022 xj=xj_safe+xshift*boxxsize
13023 yj=yj_safe+yshift*boxysize
13024 zj=zj_safe+zshift*boxzsize
13025 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13026 if(dist_temp.lt.dist_init) then
13027 dist_init=dist_temp
13036 if (subchap.eq.1) then
13046 dxj=dc_norm(1,nres+j)
13047 dyj=dc_norm(2,nres+j)
13048 dzj=dc_norm(3,nres+j)
13049 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13051 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13052 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13053 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13054 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13055 if (sss_ele_cut.le.0.0) cycle
13057 if (sss.gt.0.0d0) then
13059 ! Calculate angle-dependent terms of energy and contributions to their
13063 sig=sig0ij*dsqrt(sigsq)
13064 rij_shift=1.0D0/rij-sig+sig0ij
13065 ! for diagnostics; uncomment
13066 ! rij_shift=1.2*sig0ij
13067 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13068 if (rij_shift.le.0.0D0) then
13070 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13071 !d & restyp(itypi),i,restyp(itypj),j,
13072 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13076 !---------------------------------------------------------------
13077 rij_shift=1.0D0/rij_shift
13078 fac=rij_shift**expon
13081 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13082 eps2der=evdwij*eps3rt
13083 eps3der=evdwij*eps2rt
13084 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13085 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13086 evdwij=evdwij*eps2rt*eps3rt
13087 evdw=evdw+evdwij*sss*sss_ele_cut
13089 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13090 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13091 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13092 restyp(itypi),i,restyp(itypj),j,&
13093 epsi,sigm,chi1,chi2,chip1,chip2,&
13094 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13095 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13099 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13101 ! if (energy_dec) write (iout,*) &
13102 ! 'evdw',i,j,evdwij,"egb_short"
13104 ! Calculate gradient components.
13105 e1=e1*eps1*eps2rt**2*eps3rt**2
13106 fac=-expon*(e1+evdwij)*rij_shift
13109 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13110 /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
13111 /sigmaii(itypi,itypj))
13114 ! Calculate the radial part of the gradient
13118 ! Calculate angular part of the gradient.
13119 call sc_grad_scale(sss)
13125 ! write (iout,*) "Number of loop steps in EGB:",ind
13126 !ccc energy_dec=.false.
13128 end subroutine egb_short
13129 !-----------------------------------------------------------------------------
13130 subroutine egbv_long(evdw)
13132 ! This subroutine calculates the interaction energy of nonbonded side chains
13133 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13136 ! implicit real*8 (a-h,o-z)
13137 ! include 'DIMENSIONS'
13138 ! include 'COMMON.GEO'
13139 ! include 'COMMON.VAR'
13140 ! include 'COMMON.LOCAL'
13141 ! include 'COMMON.CHAIN'
13142 ! include 'COMMON.DERIV'
13143 ! include 'COMMON.NAMES'
13144 ! include 'COMMON.INTERACT'
13145 ! include 'COMMON.IOUNITS'
13146 ! include 'COMMON.CALC'
13148 !el integer :: icall
13149 !el common /srutu/ icall
13151 !el local variables
13152 integer :: iint,itypi,itypi1,itypj
13153 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
13154 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
13156 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13159 ! if (icall.eq.0) lprn=.true.
13161 do i=iatsc_s,iatsc_e
13163 if (itypi.eq.ntyp1) cycle
13168 dxi=dc_norm(1,nres+i)
13169 dyi=dc_norm(2,nres+i)
13170 dzi=dc_norm(3,nres+i)
13171 ! dsci_inv=dsc_inv(itypi)
13172 dsci_inv=vbld_inv(i+nres)
13174 ! Calculate SC interaction energy.
13176 do iint=1,nint_gr(i)
13177 do j=istart(i,iint),iend(i,iint)
13180 if (itypj.eq.ntyp1) cycle
13181 ! dscj_inv=dsc_inv(itypj)
13182 dscj_inv=vbld_inv(j+nres)
13183 sig0ij=sigma(itypi,itypj)
13184 r0ij=r0(itypi,itypj)
13185 chi1=chi(itypi,itypj)
13186 chi2=chi(itypj,itypi)
13193 alf12=0.5D0*(alf1+alf2)
13197 dxj=dc_norm(1,nres+j)
13198 dyj=dc_norm(2,nres+j)
13199 dzj=dc_norm(3,nres+j)
13200 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13203 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13205 if (sss.lt.1.0d0) then
13207 ! Calculate angle-dependent terms of energy and contributions to their
13211 sig=sig0ij*dsqrt(sigsq)
13212 rij_shift=1.0D0/rij-sig+r0ij
13213 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13214 if (rij_shift.le.0.0D0) then
13219 !---------------------------------------------------------------
13220 rij_shift=1.0D0/rij_shift
13221 fac=rij_shift**expon
13222 e1=fac*fac*aa_aq(itypi,itypj)
13223 e2=fac*bb_aq(itypi,itypj)
13224 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13225 eps2der=evdwij*eps3rt
13226 eps3der=evdwij*eps2rt
13227 fac_augm=rrij**expon
13228 e_augm=augm(itypi,itypj)*fac_augm
13229 evdwij=evdwij*eps2rt*eps3rt
13230 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
13232 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13233 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13234 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13235 restyp(itypi),i,restyp(itypj),j,&
13236 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13237 chi1,chi2,chip1,chip2,&
13238 eps1,eps2rt**2,eps3rt**2,&
13239 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13242 ! Calculate gradient components.
13243 e1=e1*eps1*eps2rt**2*eps3rt**2
13244 fac=-expon*(e1+evdwij)*rij_shift
13246 fac=rij*fac-2*expon*rrij*e_augm
13247 ! Calculate the radial part of the gradient
13251 ! Calculate angular part of the gradient.
13252 call sc_grad_scale(1.0d0-sss)
13257 end subroutine egbv_long
13258 !-----------------------------------------------------------------------------
13259 subroutine egbv_short(evdw)
13261 ! This subroutine calculates the interaction energy of nonbonded side chains
13262 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13265 ! implicit real*8 (a-h,o-z)
13266 ! include 'DIMENSIONS'
13267 ! include 'COMMON.GEO'
13268 ! include 'COMMON.VAR'
13269 ! include 'COMMON.LOCAL'
13270 ! include 'COMMON.CHAIN'
13271 ! include 'COMMON.DERIV'
13272 ! include 'COMMON.NAMES'
13273 ! include 'COMMON.INTERACT'
13274 ! include 'COMMON.IOUNITS'
13275 ! include 'COMMON.CALC'
13277 !el integer :: icall
13278 !el common /srutu/ icall
13280 !el local variables
13281 integer :: iint,itypi,itypi1,itypj
13282 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
13283 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
13285 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13288 ! if (icall.eq.0) lprn=.true.
13290 do i=iatsc_s,iatsc_e
13292 if (itypi.eq.ntyp1) cycle
13297 dxi=dc_norm(1,nres+i)
13298 dyi=dc_norm(2,nres+i)
13299 dzi=dc_norm(3,nres+i)
13300 ! dsci_inv=dsc_inv(itypi)
13301 dsci_inv=vbld_inv(i+nres)
13303 ! Calculate SC interaction energy.
13305 do iint=1,nint_gr(i)
13306 do j=istart(i,iint),iend(i,iint)
13309 if (itypj.eq.ntyp1) cycle
13310 ! dscj_inv=dsc_inv(itypj)
13311 dscj_inv=vbld_inv(j+nres)
13312 sig0ij=sigma(itypi,itypj)
13313 r0ij=r0(itypi,itypj)
13314 chi1=chi(itypi,itypj)
13315 chi2=chi(itypj,itypi)
13322 alf12=0.5D0*(alf1+alf2)
13326 dxj=dc_norm(1,nres+j)
13327 dyj=dc_norm(2,nres+j)
13328 dzj=dc_norm(3,nres+j)
13329 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13332 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13334 if (sss.gt.0.0d0) then
13336 ! Calculate angle-dependent terms of energy and contributions to their
13340 sig=sig0ij*dsqrt(sigsq)
13341 rij_shift=1.0D0/rij-sig+r0ij
13342 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13343 if (rij_shift.le.0.0D0) then
13348 !---------------------------------------------------------------
13349 rij_shift=1.0D0/rij_shift
13350 fac=rij_shift**expon
13351 e1=fac*fac*aa_aq(itypi,itypj)
13352 e2=fac*bb_aq(itypi,itypj)
13353 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13354 eps2der=evdwij*eps3rt
13355 eps3der=evdwij*eps2rt
13356 fac_augm=rrij**expon
13357 e_augm=augm(itypi,itypj)*fac_augm
13358 evdwij=evdwij*eps2rt*eps3rt
13359 evdw=evdw+(evdwij+e_augm)*sss
13361 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13362 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13363 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13364 restyp(itypi),i,restyp(itypj),j,&
13365 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13366 chi1,chi2,chip1,chip2,&
13367 eps1,eps2rt**2,eps3rt**2,&
13368 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13371 ! Calculate gradient components.
13372 e1=e1*eps1*eps2rt**2*eps3rt**2
13373 fac=-expon*(e1+evdwij)*rij_shift
13375 fac=rij*fac-2*expon*rrij*e_augm
13376 ! Calculate the radial part of the gradient
13380 ! Calculate angular part of the gradient.
13381 call sc_grad_scale(sss)
13386 end subroutine egbv_short
13387 !-----------------------------------------------------------------------------
13388 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13390 ! This subroutine calculates the average interaction energy and its gradient
13391 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
13392 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
13393 ! The potential depends both on the distance of peptide-group centers and on
13394 ! the orientation of the CA-CA virtual bonds.
13396 ! implicit real*8 (a-h,o-z)
13402 ! include 'DIMENSIONS'
13403 ! include 'COMMON.CONTROL'
13404 ! include 'COMMON.SETUP'
13405 ! include 'COMMON.IOUNITS'
13406 ! include 'COMMON.GEO'
13407 ! include 'COMMON.VAR'
13408 ! include 'COMMON.LOCAL'
13409 ! include 'COMMON.CHAIN'
13410 ! include 'COMMON.DERIV'
13411 ! include 'COMMON.INTERACT'
13412 ! include 'COMMON.CONTACTS'
13413 ! include 'COMMON.TORSION'
13414 ! include 'COMMON.VECTORS'
13415 ! include 'COMMON.FFIELD'
13416 ! include 'COMMON.TIME1'
13417 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
13418 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
13419 real(kind=8),dimension(2,2) :: acipa !el,a_temp
13420 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
13421 real(kind=8),dimension(4) :: muij
13422 !el integer :: num_conti,j1,j2
13423 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
13424 !el dz_normi,xmedi,ymedi,zmedi
13425 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
13426 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13427 !el num_conti,j1,j2
13428 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13430 real(kind=8) :: scal_el=1.0d0
13432 real(kind=8) :: scal_el=0.5d0
13435 ! 13-go grudnia roku pamietnego...
13436 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
13437 0.0d0,1.0d0,0.0d0,&
13438 0.0d0,0.0d0,1.0d0/),shape(unmat))
13439 !el local variables
13441 real(kind=8) :: fac
13442 real(kind=8) :: dxj,dyj,dzj
13443 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
13445 ! allocate(num_cont_hb(nres)) !(maxres)
13446 !d write(iout,*) 'In EELEC'
13448 !d write(iout,*) 'Type',i
13449 !d write(iout,*) 'B1',B1(:,i)
13450 !d write(iout,*) 'B2',B2(:,i)
13451 !d write(iout,*) 'CC',CC(:,:,i)
13452 !d write(iout,*) 'DD',DD(:,:,i)
13453 !d write(iout,*) 'EE',EE(:,:,i)
13455 !d call check_vecgrad
13457 if (icheckgrad.eq.1) then
13459 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
13461 dc_norm(k,i)=dc(k,i)*fac
13463 ! write (iout,*) 'i',i,' fac',fac
13466 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
13467 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
13468 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
13469 ! call vec_and_deriv
13473 ! print *, "before set matrices"
13475 ! print *,"after set martices"
13477 time_mat=time_mat+MPI_Wtime()-time01
13481 !d write (iout,*) 'i=',i
13483 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
13486 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
13487 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
13500 !d print '(a)','Enter EELEC'
13501 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
13502 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
13503 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
13505 gel_loc_loc(i)=0.0d0
13510 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
13512 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
13514 do i=iturn3_start,iturn3_end
13515 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1 &
13516 .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
13520 dx_normi=dc_norm(1,i)
13521 dy_normi=dc_norm(2,i)
13522 dz_normi=dc_norm(3,i)
13523 xmedi=c(1,i)+0.5d0*dxi
13524 ymedi=c(2,i)+0.5d0*dyi
13525 zmedi=c(3,i)+0.5d0*dzi
13526 xmedi=dmod(xmedi,boxxsize)
13527 if (xmedi.lt.0) xmedi=xmedi+boxxsize
13528 ymedi=dmod(ymedi,boxysize)
13529 if (ymedi.lt.0) ymedi=ymedi+boxysize
13530 zmedi=dmod(zmedi,boxzsize)
13531 if (zmedi.lt.0) zmedi=zmedi+boxzsize
13533 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
13534 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
13535 num_cont_hb(i)=num_conti
13537 do i=iturn4_start,iturn4_end
13538 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
13539 .or. itype(i+3).eq.ntyp1 &
13540 .or. itype(i+4).eq.ntyp1) cycle
13544 dx_normi=dc_norm(1,i)
13545 dy_normi=dc_norm(2,i)
13546 dz_normi=dc_norm(3,i)
13547 xmedi=c(1,i)+0.5d0*dxi
13548 ymedi=c(2,i)+0.5d0*dyi
13549 zmedi=c(3,i)+0.5d0*dzi
13550 xmedi=dmod(xmedi,boxxsize)
13551 if (xmedi.lt.0) xmedi=xmedi+boxxsize
13552 ymedi=dmod(ymedi,boxysize)
13553 if (ymedi.lt.0) ymedi=ymedi+boxysize
13554 zmedi=dmod(zmedi,boxzsize)
13555 if (zmedi.lt.0) zmedi=zmedi+boxzsize
13556 num_conti=num_cont_hb(i)
13557 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
13558 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
13559 call eturn4(i,eello_turn4)
13560 num_cont_hb(i)=num_conti
13563 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
13565 do i=iatel_s,iatel_e
13566 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
13570 dx_normi=dc_norm(1,i)
13571 dy_normi=dc_norm(2,i)
13572 dz_normi=dc_norm(3,i)
13573 xmedi=c(1,i)+0.5d0*dxi
13574 ymedi=c(2,i)+0.5d0*dyi
13575 zmedi=c(3,i)+0.5d0*dzi
13576 xmedi=dmod(xmedi,boxxsize)
13577 if (xmedi.lt.0) xmedi=xmedi+boxxsize
13578 ymedi=dmod(ymedi,boxysize)
13579 if (ymedi.lt.0) ymedi=ymedi+boxysize
13580 zmedi=dmod(zmedi,boxzsize)
13581 if (zmedi.lt.0) zmedi=zmedi+boxzsize
13582 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
13583 num_conti=num_cont_hb(i)
13584 do j=ielstart(i),ielend(i)
13585 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
13586 call eelecij_scale(i,j,ees,evdw1,eel_loc)
13588 num_cont_hb(i)=num_conti
13590 ! write (iout,*) "Number of loop steps in EELEC:",ind
13592 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
13593 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
13595 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
13596 !cc eel_loc=eel_loc+eello_turn3
13597 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
13599 end subroutine eelec_scale
13600 !-----------------------------------------------------------------------------
13601 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
13602 ! implicit real*8 (a-h,o-z)
13605 ! include 'DIMENSIONS'
13609 ! include 'COMMON.CONTROL'
13610 ! include 'COMMON.IOUNITS'
13611 ! include 'COMMON.GEO'
13612 ! include 'COMMON.VAR'
13613 ! include 'COMMON.LOCAL'
13614 ! include 'COMMON.CHAIN'
13615 ! include 'COMMON.DERIV'
13616 ! include 'COMMON.INTERACT'
13617 ! include 'COMMON.CONTACTS'
13618 ! include 'COMMON.TORSION'
13619 ! include 'COMMON.VECTORS'
13620 ! include 'COMMON.FFIELD'
13621 ! include 'COMMON.TIME1'
13622 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
13623 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
13624 real(kind=8),dimension(2,2) :: acipa !el,a_temp
13625 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
13626 real(kind=8),dimension(4) :: muij
13627 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13628 dist_temp, dist_init,sss_grad
13629 integer xshift,yshift,zshift
13631 !el integer :: num_conti,j1,j2
13632 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
13633 !el dz_normi,xmedi,ymedi,zmedi
13634 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
13635 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13636 !el num_conti,j1,j2
13637 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13639 real(kind=8) :: scal_el=1.0d0
13641 real(kind=8) :: scal_el=0.5d0
13644 ! 13-go grudnia roku pamietnego...
13645 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
13646 0.0d0,1.0d0,0.0d0,&
13647 0.0d0,0.0d0,1.0d0/),shape(unmat))
13648 !el local variables
13649 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
13650 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
13651 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
13652 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
13653 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
13654 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
13655 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
13656 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
13657 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
13658 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
13659 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
13660 ecosam,ecosbm,ecosgm,ghalf,time00
13661 ! integer :: maxconts
13662 ! maxconts = nres/4
13663 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13664 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13665 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13666 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13667 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13668 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13669 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13670 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13671 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
13672 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
13673 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
13674 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
13675 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
13677 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
13678 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
13683 !d write (iout,*) "eelecij",i,j
13687 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
13688 aaa=app(iteli,itelj)
13689 bbb=bpp(iteli,itelj)
13690 ael6i=ael6(iteli,itelj)
13691 ael3i=ael3(iteli,itelj)
13695 dx_normj=dc_norm(1,j)
13696 dy_normj=dc_norm(2,j)
13697 dz_normj=dc_norm(3,j)
13698 ! xj=c(1,j)+0.5D0*dxj-xmedi
13699 ! yj=c(2,j)+0.5D0*dyj-ymedi
13700 ! zj=c(3,j)+0.5D0*dzj-zmedi
13701 xj=c(1,j)+0.5D0*dxj
13702 yj=c(2,j)+0.5D0*dyj
13703 zj=c(3,j)+0.5D0*dzj
13704 xj=mod(xj,boxxsize)
13705 if (xj.lt.0) xj=xj+boxxsize
13706 yj=mod(yj,boxysize)
13707 if (yj.lt.0) yj=yj+boxysize
13708 zj=mod(zj,boxzsize)
13709 if (zj.lt.0) zj=zj+boxzsize
13711 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
13718 xj=xj_safe+xshift*boxxsize
13719 yj=yj_safe+yshift*boxysize
13720 zj=zj_safe+zshift*boxzsize
13721 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
13722 if(dist_temp.lt.dist_init) then
13723 dist_init=dist_temp
13732 if (isubchap.eq.1) then
13743 rij=xj*xj+yj*yj+zj*zj
13747 ! For extracting the short-range part of Evdwpp
13748 sss=sscale(rij/rpp(iteli,itelj))
13749 sss_ele_cut=sscale_ele(rij)
13750 sss_ele_grad=sscagrad_ele(rij)
13751 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
13752 ! sss_ele_cut=1.0d0
13753 ! sss_ele_grad=0.0d0
13754 if (sss_ele_cut.le.0.0) go to 128
13758 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
13759 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
13760 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
13761 fac=cosa-3.0D0*cosb*cosg
13763 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
13764 if (j.eq.i+2) ev1=scal_el*ev1
13769 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
13772 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
13773 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
13774 ees=ees+eesij*sss_ele_cut
13775 evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
13776 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
13777 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
13778 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
13779 !d & xmedi,ymedi,zmedi,xj,yj,zj
13781 if (energy_dec) then
13782 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
13783 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
13787 ! Calculate contributions to the Cartesian gradient.
13790 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
13791 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
13797 ! Radial derivatives. First process both termini of the fragment (i,j)
13799 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
13800 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
13801 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
13803 ! ghalf=0.5D0*ggg(k)
13804 ! gelc(k,i)=gelc(k,i)+ghalf
13805 ! gelc(k,j)=gelc(k,j)+ghalf
13807 ! 9/28/08 AL Gradient compotents will be summed only at the end
13809 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
13810 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
13813 ! Loop over residues i+1 thru j-1.
13817 !grad gelc(l,k)=gelc(l,k)+ggg(l)
13820 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
13821 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
13822 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
13823 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
13824 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
13825 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
13827 ! ghalf=0.5D0*ggg(k)
13828 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
13829 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
13831 ! 9/28/08 AL Gradient compotents will be summed only at the end
13833 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
13834 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
13837 ! Loop over residues i+1 thru j-1.
13841 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
13845 facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
13846 facel=(el1+eesij)*sss_ele_cut
13848 fac=-3*rrmij*(facvdw+facvdw+facel)
13853 ! Radial derivatives. First process both termini of the fragment (i,j)
13859 ! ghalf=0.5D0*ggg(k)
13860 ! gelc(k,i)=gelc(k,i)+ghalf
13861 ! gelc(k,j)=gelc(k,j)+ghalf
13863 ! 9/28/08 AL Gradient compotents will be summed only at the end
13865 gelc_long(k,j)=gelc(k,j)+ggg(k)
13866 gelc_long(k,i)=gelc(k,i)-ggg(k)
13869 ! Loop over residues i+1 thru j-1.
13873 !grad gelc(l,k)=gelc(l,k)+ggg(l)
13876 ! 9/28/08 AL Gradient compotents will be summed only at the end
13881 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
13882 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
13888 ecosa=2.0D0*fac3*fac1+fac4
13891 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
13892 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
13894 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
13895 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
13897 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
13898 !d & (dcosg(k),k=1,3)
13900 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
13903 ! ghalf=0.5D0*ggg(k)
13904 ! gelc(k,i)=gelc(k,i)+ghalf
13905 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
13906 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
13907 ! gelc(k,j)=gelc(k,j)+ghalf
13908 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
13909 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
13913 !grad gelc(l,k)=gelc(l,k)+ggg(l)
13917 gelc(k,i)=gelc(k,i) &
13918 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
13919 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
13921 gelc(k,j)=gelc(k,j) &
13922 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
13923 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
13925 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
13926 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
13928 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
13929 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
13930 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
13932 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
13933 ! energy of a peptide unit is assumed in the form of a second-order
13934 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
13935 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
13936 ! are computed for EVERY pair of non-contiguous peptide groups.
13938 if (j.lt.nres-1) then
13949 muij(kkk)=mu(k,i)*mu(l,j)
13952 !d write (iout,*) 'EELEC: i',i,' j',j
13953 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
13954 !d write(iout,*) 'muij',muij
13955 ury=scalar(uy(1,i),erij)
13956 urz=scalar(uz(1,i),erij)
13957 vry=scalar(uy(1,j),erij)
13958 vrz=scalar(uz(1,j),erij)
13959 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
13960 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
13961 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
13962 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
13963 fac=dsqrt(-ael6i)*r3ij
13968 !d write (iout,'(4i5,4f10.5)')
13969 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
13970 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
13971 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
13972 !d & uy(:,j),uz(:,j)
13973 !d write (iout,'(4f10.5)')
13974 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
13975 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
13976 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
13977 !d write (iout,'(9f10.5/)')
13978 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
13979 ! Derivatives of the elements of A in virtual-bond vectors
13980 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
13982 uryg(k,1)=scalar(erder(1,k),uy(1,i))
13983 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
13984 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
13985 urzg(k,1)=scalar(erder(1,k),uz(1,i))
13986 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
13987 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
13988 vryg(k,1)=scalar(erder(1,k),uy(1,j))
13989 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
13990 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
13991 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
13992 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
13993 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
13995 ! Compute radial contributions to the gradient
14013 ! Add the contributions coming from er
14016 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
14017 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
14018 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
14019 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
14022 ! Derivatives in DC(i)
14023 !grad ghalf1=0.5d0*agg(k,1)
14024 !grad ghalf2=0.5d0*agg(k,2)
14025 !grad ghalf3=0.5d0*agg(k,3)
14026 !grad ghalf4=0.5d0*agg(k,4)
14027 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
14028 -3.0d0*uryg(k,2)*vry)!+ghalf1
14029 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
14030 -3.0d0*uryg(k,2)*vrz)!+ghalf2
14031 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
14032 -3.0d0*urzg(k,2)*vry)!+ghalf3
14033 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
14034 -3.0d0*urzg(k,2)*vrz)!+ghalf4
14035 ! Derivatives in DC(i+1)
14036 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
14037 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
14038 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
14039 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
14040 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
14041 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
14042 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
14043 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
14044 ! Derivatives in DC(j)
14045 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
14046 -3.0d0*vryg(k,2)*ury)!+ghalf1
14047 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
14048 -3.0d0*vrzg(k,2)*ury)!+ghalf2
14049 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
14050 -3.0d0*vryg(k,2)*urz)!+ghalf3
14051 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
14052 -3.0d0*vrzg(k,2)*urz)!+ghalf4
14053 ! Derivatives in DC(j+1) or DC(nres-1)
14054 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
14055 -3.0d0*vryg(k,3)*ury)
14056 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
14057 -3.0d0*vrzg(k,3)*ury)
14058 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
14059 -3.0d0*vryg(k,3)*urz)
14060 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
14061 -3.0d0*vrzg(k,3)*urz)
14062 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
14064 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
14077 aggi(k,l)=-aggi(k,l)
14078 aggi1(k,l)=-aggi1(k,l)
14079 aggj(k,l)=-aggj(k,l)
14080 aggj1(k,l)=-aggj1(k,l)
14083 if (j.lt.nres-1) then
14089 aggi(k,l)=-aggi(k,l)
14090 aggi1(k,l)=-aggi1(k,l)
14091 aggj(k,l)=-aggj(k,l)
14092 aggj1(k,l)=-aggj1(k,l)
14103 aggi(k,l)=-aggi(k,l)
14104 aggi1(k,l)=-aggi1(k,l)
14105 aggj(k,l)=-aggj(k,l)
14106 aggj1(k,l)=-aggj1(k,l)
14111 IF (wel_loc.gt.0.0d0) THEN
14112 ! Contribution to the local-electrostatic energy coming from the i-j pair
14113 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
14115 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
14117 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14118 'eelloc',i,j,eel_loc_ij
14119 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
14121 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
14122 ! Partial derivatives in virtual-bond dihedral angles gamma
14124 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
14125 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
14126 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
14128 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
14129 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
14130 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
14136 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
14138 ggg(l)=(agg(l,1)*muij(1)+ &
14139 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
14141 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
14143 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
14144 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
14145 !grad ghalf=0.5d0*ggg(l)
14146 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
14147 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
14151 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
14154 ! Remaining derivatives of eello
14156 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
14157 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
14160 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
14161 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
14164 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
14165 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
14168 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
14169 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
14174 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
14175 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
14176 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
14177 .and. num_conti.le.maxconts) then
14178 ! write (iout,*) i,j," entered corr"
14180 ! Calculate the contact function. The ith column of the array JCONT will
14181 ! contain the numbers of atoms that make contacts with the atom I (of numbers
14182 ! greater than I). The arrays FACONT and GACONT will contain the values of
14183 ! the contact function and its derivative.
14184 ! r0ij=1.02D0*rpp(iteli,itelj)
14185 ! r0ij=1.11D0*rpp(iteli,itelj)
14186 r0ij=2.20D0*rpp(iteli,itelj)
14187 ! r0ij=1.55D0*rpp(iteli,itelj)
14188 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
14189 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14190 if (fcont.gt.0.0D0) then
14191 num_conti=num_conti+1
14192 if (num_conti.gt.maxconts) then
14193 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14194 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
14195 ' will skip next contacts for this conf.',num_conti
14197 jcont_hb(num_conti,i)=j
14198 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
14199 !d & " jcont_hb",jcont_hb(num_conti,i)
14200 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
14201 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14202 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
14204 d_cont(num_conti,i)=rij
14205 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
14206 ! --- Electrostatic-interaction matrix ---
14207 a_chuj(1,1,num_conti,i)=a22
14208 a_chuj(1,2,num_conti,i)=a23
14209 a_chuj(2,1,num_conti,i)=a32
14210 a_chuj(2,2,num_conti,i)=a33
14211 ! --- Gradient of rij
14213 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
14220 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
14221 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
14222 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
14223 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
14224 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
14229 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
14230 ! Calculate contact energies
14232 wij=cosa-3.0D0*cosb*cosg
14235 ! fac3=dsqrt(-ael6i)/r0ij**3
14236 fac3=dsqrt(-ael6i)*r3ij
14237 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
14238 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
14239 if (ees0tmp.gt.0) then
14240 ees0pij=dsqrt(ees0tmp)
14244 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
14245 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
14246 if (ees0tmp.gt.0) then
14247 ees0mij=dsqrt(ees0tmp)
14252 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
14255 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
14258 ! Diagnostics. Comment out or remove after debugging!
14259 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
14260 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
14261 ! ees0m(num_conti,i)=0.0D0
14263 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
14264 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
14265 ! Angular derivatives of the contact function
14266 ees0pij1=fac3/ees0pij
14267 ees0mij1=fac3/ees0mij
14268 fac3p=-3.0D0*fac3*rrmij
14269 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
14270 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
14272 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
14273 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
14274 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
14275 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
14276 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
14277 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
14278 ecosap=ecosa1+ecosa2
14279 ecosbp=ecosb1+ecosb2
14280 ecosgp=ecosg1+ecosg2
14281 ecosam=ecosa1-ecosa2
14282 ecosbm=ecosb1-ecosb2
14283 ecosgm=ecosg1-ecosg2
14292 facont_hb(num_conti,i)=fcont
14293 fprimcont=fprimcont/rij
14294 !d facont_hb(num_conti,i)=1.0D0
14295 ! Following line is for diagnostics.
14298 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14299 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14302 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
14303 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
14305 ! gggp(1)=gggp(1)+ees0pijp*xj
14306 ! gggp(2)=gggp(2)+ees0pijp*yj
14307 ! gggp(3)=gggp(3)+ees0pijp*zj
14308 ! gggm(1)=gggm(1)+ees0mijp*xj
14309 ! gggm(2)=gggm(2)+ees0mijp*yj
14310 ! gggm(3)=gggm(3)+ees0mijp*zj
14311 gggp(1)=gggp(1)+ees0pijp*xj &
14312 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14313 gggp(2)=gggp(2)+ees0pijp*yj &
14314 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14315 gggp(3)=gggp(3)+ees0pijp*zj &
14316 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14318 gggm(1)=gggm(1)+ees0mijp*xj &
14319 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14321 gggm(2)=gggm(2)+ees0mijp*yj &
14322 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14324 gggm(3)=gggm(3)+ees0mijp*zj &
14325 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14327 ! Derivatives due to the contact function
14328 gacont_hbr(1,num_conti,i)=fprimcont*xj
14329 gacont_hbr(2,num_conti,i)=fprimcont*yj
14330 gacont_hbr(3,num_conti,i)=fprimcont*zj
14333 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
14334 ! following the change of gradient-summation algorithm.
14336 !grad ghalfp=0.5D0*gggp(k)
14337 !grad ghalfm=0.5D0*gggm(k)
14338 ! gacontp_hb1(k,num_conti,i)= & !ghalfp
14339 ! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14340 ! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14341 ! gacontp_hb2(k,num_conti,i)= & !ghalfp
14342 ! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14343 ! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14344 ! gacontp_hb3(k,num_conti,i)=gggp(k)
14345 ! gacontm_hb1(k,num_conti,i)= &!ghalfm
14346 ! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14347 ! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14348 ! gacontm_hb2(k,num_conti,i)= & !ghalfm
14349 ! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14350 ! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14351 ! gacontm_hb3(k,num_conti,i)=gggm(k)
14352 gacontp_hb1(k,num_conti,i)= & !ghalfp+
14353 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14354 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14357 gacontp_hb2(k,num_conti,i)= & !ghalfp+
14358 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14359 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14362 gacontp_hb3(k,num_conti,i)=gggp(k) &
14365 gacontm_hb1(k,num_conti,i)= & !ghalfm+
14366 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14367 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14370 gacontm_hb2(k,num_conti,i)= & !ghalfm+
14371 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14372 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
14375 gacontm_hb3(k,num_conti,i)=gggm(k) &
14380 endif ! num_conti.le.maxconts
14383 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
14386 ghalf=0.5d0*agg(l,k)
14387 aggi(l,k)=aggi(l,k)+ghalf
14388 aggi1(l,k)=aggi1(l,k)+agg(l,k)
14389 aggj(l,k)=aggj(l,k)+ghalf
14392 if (j.eq.nres-1 .and. i.lt.j-2) then
14395 aggj1(l,k)=aggj1(l,k)+agg(l,k)
14401 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
14403 end subroutine eelecij_scale
14404 !-----------------------------------------------------------------------------
14405 subroutine evdwpp_short(evdw1)
14409 ! implicit real*8 (a-h,o-z)
14410 ! include 'DIMENSIONS'
14411 ! include 'COMMON.CONTROL'
14412 ! include 'COMMON.IOUNITS'
14413 ! include 'COMMON.GEO'
14414 ! include 'COMMON.VAR'
14415 ! include 'COMMON.LOCAL'
14416 ! include 'COMMON.CHAIN'
14417 ! include 'COMMON.DERIV'
14418 ! include 'COMMON.INTERACT'
14419 ! include 'COMMON.CONTACTS'
14420 ! include 'COMMON.TORSION'
14421 ! include 'COMMON.VECTORS'
14422 ! include 'COMMON.FFIELD'
14423 real(kind=8),dimension(3) :: ggg
14424 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14426 real(kind=8) :: scal_el=1.0d0
14428 real(kind=8) :: scal_el=0.5d0
14430 !el local variables
14431 integer :: i,j,k,iteli,itelj,num_conti,isubchap
14432 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
14433 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
14434 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14435 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
14436 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14437 dist_temp, dist_init,sss_grad
14438 integer xshift,yshift,zshift
14442 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
14443 ! & " iatel_e_vdw",iatel_e_vdw
14445 do i=iatel_s_vdw,iatel_e_vdw
14446 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle
14450 dx_normi=dc_norm(1,i)
14451 dy_normi=dc_norm(2,i)
14452 dz_normi=dc_norm(3,i)
14453 xmedi=c(1,i)+0.5d0*dxi
14454 ymedi=c(2,i)+0.5d0*dyi
14455 zmedi=c(3,i)+0.5d0*dzi
14456 xmedi=dmod(xmedi,boxxsize)
14457 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14458 ymedi=dmod(ymedi,boxysize)
14459 if (ymedi.lt.0) ymedi=ymedi+boxysize
14460 zmedi=dmod(zmedi,boxzsize)
14461 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14463 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
14464 ! & ' ielend',ielend_vdw(i)
14466 do j=ielstart_vdw(i),ielend_vdw(i)
14467 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
14471 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14472 aaa=app(iteli,itelj)
14473 bbb=bpp(iteli,itelj)
14477 dx_normj=dc_norm(1,j)
14478 dy_normj=dc_norm(2,j)
14479 dz_normj=dc_norm(3,j)
14480 ! xj=c(1,j)+0.5D0*dxj-xmedi
14481 ! yj=c(2,j)+0.5D0*dyj-ymedi
14482 ! zj=c(3,j)+0.5D0*dzj-zmedi
14483 xj=c(1,j)+0.5D0*dxj
14484 yj=c(2,j)+0.5D0*dyj
14485 zj=c(3,j)+0.5D0*dzj
14486 xj=mod(xj,boxxsize)
14487 if (xj.lt.0) xj=xj+boxxsize
14488 yj=mod(yj,boxysize)
14489 if (yj.lt.0) yj=yj+boxysize
14490 zj=mod(zj,boxzsize)
14491 if (zj.lt.0) zj=zj+boxzsize
14493 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14500 xj=xj_safe+xshift*boxxsize
14501 yj=yj_safe+yshift*boxysize
14502 zj=zj_safe+zshift*boxzsize
14503 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14504 if(dist_temp.lt.dist_init) then
14505 dist_init=dist_temp
14514 if (isubchap.eq.1) then
14525 rij=xj*xj+yj*yj+zj*zj
14528 sss=sscale(rij/rpp(iteli,itelj))
14529 sss_ele_cut=sscale_ele(rij)
14530 sss_ele_grad=sscagrad_ele(rij)
14531 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
14532 if (sss_ele_cut.le.0.0) cycle
14533 if (sss.gt.0.0d0) then
14538 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
14539 if (j.eq.i+2) ev1=scal_el*ev1
14542 if (energy_dec) then
14543 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
14545 evdw1=evdw1+evdwij*sss*sss_ele_cut
14547 ! Calculate contributions to the Cartesian gradient.
14549 facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
14553 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
14554 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14555 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
14556 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14557 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
14558 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14561 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14562 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14568 end subroutine evdwpp_short
14569 !-----------------------------------------------------------------------------
14570 subroutine escp_long(evdw2,evdw2_14)
14572 ! This subroutine calculates the excluded-volume interaction energy between
14573 ! peptide-group centers and side chains and its gradient in virtual-bond and
14574 ! side-chain vectors.
14576 ! implicit real*8 (a-h,o-z)
14577 ! include 'DIMENSIONS'
14578 ! include 'COMMON.GEO'
14579 ! include 'COMMON.VAR'
14580 ! include 'COMMON.LOCAL'
14581 ! include 'COMMON.CHAIN'
14582 ! include 'COMMON.DERIV'
14583 ! include 'COMMON.INTERACT'
14584 ! include 'COMMON.FFIELD'
14585 ! include 'COMMON.IOUNITS'
14586 ! include 'COMMON.CONTROL'
14587 real(kind=8),dimension(3) :: ggg
14588 !el local variables
14589 integer :: i,iint,j,k,iteli,itypj,subchap
14590 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
14591 real(kind=8) :: evdw2,evdw2_14,evdwij
14592 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14593 dist_temp, dist_init
14597 !d print '(a)','Enter ESCP'
14598 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
14599 do i=iatscp_s,iatscp_e
14600 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
14602 xi=0.5D0*(c(1,i)+c(1,i+1))
14603 yi=0.5D0*(c(2,i)+c(2,i+1))
14604 zi=0.5D0*(c(3,i)+c(3,i+1))
14605 xi=mod(xi,boxxsize)
14606 if (xi.lt.0) xi=xi+boxxsize
14607 yi=mod(yi,boxysize)
14608 if (yi.lt.0) yi=yi+boxysize
14609 zi=mod(zi,boxzsize)
14610 if (zi.lt.0) zi=zi+boxzsize
14612 do iint=1,nscp_gr(i)
14614 do j=iscpstart(i,iint),iscpend(i,iint)
14616 if (itypj.eq.ntyp1) cycle
14617 ! Uncomment following three lines for SC-p interactions
14618 ! xj=c(1,nres+j)-xi
14619 ! yj=c(2,nres+j)-yi
14620 ! zj=c(3,nres+j)-zi
14621 ! Uncomment following three lines for Ca-p interactions
14625 xj=mod(xj,boxxsize)
14626 if (xj.lt.0) xj=xj+boxxsize
14627 yj=mod(yj,boxysize)
14628 if (yj.lt.0) yj=yj+boxysize
14629 zj=mod(zj,boxzsize)
14630 if (zj.lt.0) zj=zj+boxzsize
14631 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14639 xj=xj_safe+xshift*boxxsize
14640 yj=yj_safe+yshift*boxysize
14641 zj=zj_safe+zshift*boxzsize
14642 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14643 if(dist_temp.lt.dist_init) then
14644 dist_init=dist_temp
14653 if (subchap.eq.1) then
14662 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14664 rij=dsqrt(1.0d0/rrij)
14665 sss_ele_cut=sscale_ele(rij)
14666 sss_ele_grad=sscagrad_ele(rij)
14667 ! print *,sss_ele_cut,sss_ele_grad,&
14668 ! (rij),r_cut_ele,rlamb_ele
14669 if (sss_ele_cut.le.0.0) cycle
14670 sss=sscale((rij/rscp(itypj,iteli)))
14671 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
14672 if (sss.lt.1.0d0) then
14675 e1=fac*fac*aad(itypj,iteli)
14676 e2=fac*bad(itypj,iteli)
14677 if (iabs(j-i) .le. 2) then
14680 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
14683 evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
14684 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
14685 'evdw2',i,j,sss,evdwij
14687 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
14689 fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
14690 fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
14691 -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
14695 ! Uncomment following three lines for SC-p interactions
14697 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
14699 ! Uncomment following line for SC-p interactions
14700 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
14702 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
14703 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
14712 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
14713 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
14714 gradx_scp(j,i)=expon*gradx_scp(j,i)
14717 !******************************************************************************
14721 ! To save time the factor EXPON has been extracted from ALL components
14722 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
14725 !******************************************************************************
14727 end subroutine escp_long
14728 !-----------------------------------------------------------------------------
14729 subroutine escp_short(evdw2,evdw2_14)
14731 ! This subroutine calculates the excluded-volume interaction energy between
14732 ! peptide-group centers and side chains and its gradient in virtual-bond and
14733 ! side-chain vectors.
14735 ! implicit real*8 (a-h,o-z)
14736 ! include 'DIMENSIONS'
14737 ! include 'COMMON.GEO'
14738 ! include 'COMMON.VAR'
14739 ! include 'COMMON.LOCAL'
14740 ! include 'COMMON.CHAIN'
14741 ! include 'COMMON.DERIV'
14742 ! include 'COMMON.INTERACT'
14743 ! include 'COMMON.FFIELD'
14744 ! include 'COMMON.IOUNITS'
14745 ! include 'COMMON.CONTROL'
14746 real(kind=8),dimension(3) :: ggg
14747 !el local variables
14748 integer :: i,iint,j,k,iteli,itypj,subchap
14749 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
14750 real(kind=8) :: evdw2,evdw2_14,evdwij
14751 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14752 dist_temp, dist_init
14756 !d print '(a)','Enter ESCP'
14757 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
14758 do i=iatscp_s,iatscp_e
14759 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
14761 xi=0.5D0*(c(1,i)+c(1,i+1))
14762 yi=0.5D0*(c(2,i)+c(2,i+1))
14763 zi=0.5D0*(c(3,i)+c(3,i+1))
14764 xi=mod(xi,boxxsize)
14765 if (xi.lt.0) xi=xi+boxxsize
14766 yi=mod(yi,boxysize)
14767 if (yi.lt.0) yi=yi+boxysize
14768 zi=mod(zi,boxzsize)
14769 if (zi.lt.0) zi=zi+boxzsize
14771 do iint=1,nscp_gr(i)
14773 do j=iscpstart(i,iint),iscpend(i,iint)
14775 if (itypj.eq.ntyp1) cycle
14776 ! Uncomment following three lines for SC-p interactions
14777 ! xj=c(1,nres+j)-xi
14778 ! yj=c(2,nres+j)-yi
14779 ! zj=c(3,nres+j)-zi
14780 ! Uncomment following three lines for Ca-p interactions
14787 xj=mod(xj,boxxsize)
14788 if (xj.lt.0) xj=xj+boxxsize
14789 yj=mod(yj,boxysize)
14790 if (yj.lt.0) yj=yj+boxysize
14791 zj=mod(zj,boxzsize)
14792 if (zj.lt.0) zj=zj+boxzsize
14793 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14801 xj=xj_safe+xshift*boxxsize
14802 yj=yj_safe+yshift*boxysize
14803 zj=zj_safe+zshift*boxzsize
14804 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14805 if(dist_temp.lt.dist_init) then
14806 dist_init=dist_temp
14815 if (subchap.eq.1) then
14825 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14826 rij=dsqrt(1.0d0/rrij)
14827 sss_ele_cut=sscale_ele(rij)
14828 sss_ele_grad=sscagrad_ele(rij)
14829 ! print *,sss_ele_cut,sss_ele_grad,&
14830 ! (rij),r_cut_ele,rlamb_ele
14831 if (sss_ele_cut.le.0.0) cycle
14832 sss=sscale(rij/rscp(itypj,iteli))
14833 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
14834 if (sss.gt.0.0d0) then
14837 e1=fac*fac*aad(itypj,iteli)
14838 e2=fac*bad(itypj,iteli)
14839 if (iabs(j-i) .le. 2) then
14842 evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
14845 evdw2=evdw2+evdwij*sss*sss_ele_cut
14846 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
14847 'evdw2',i,j,sss,evdwij
14849 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
14851 fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
14852 fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
14853 +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
14858 ! Uncomment following three lines for SC-p interactions
14860 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
14862 ! Uncomment following line for SC-p interactions
14863 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
14865 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
14866 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
14875 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
14876 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
14877 gradx_scp(j,i)=expon*gradx_scp(j,i)
14880 !******************************************************************************
14884 ! To save time the factor EXPON has been extracted from ALL components
14885 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
14888 !******************************************************************************
14890 end subroutine escp_short
14891 !-----------------------------------------------------------------------------
14892 ! energy_p_new-sep_barrier.F
14893 !-----------------------------------------------------------------------------
14894 subroutine sc_grad_scale(scalfac)
14895 ! implicit real*8 (a-h,o-z)
14897 ! include 'DIMENSIONS'
14898 ! include 'COMMON.CHAIN'
14899 ! include 'COMMON.DERIV'
14900 ! include 'COMMON.CALC'
14901 ! include 'COMMON.IOUNITS'
14902 real(kind=8),dimension(3) :: dcosom1,dcosom2
14903 real(kind=8) :: scalfac
14904 !el local variables
14905 ! integer :: i,j,k,l
14907 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
14908 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
14909 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
14910 -2.0D0*alf12*eps3der+sigder*sigsq_om12
14914 ! eom12=evdwij*eps1_om12
14916 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
14917 ! & " sigder",sigder
14918 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
14919 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
14921 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
14922 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
14925 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
14928 ! write (iout,*) "gg",(gg(k),k=1,3)
14930 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
14931 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
14932 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
14934 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
14935 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
14936 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
14938 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
14939 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
14940 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
14941 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
14944 ! Calculate the components of the gradient in DC and X
14947 gvdwc(l,i)=gvdwc(l,i)-gg(l)
14948 gvdwc(l,j)=gvdwc(l,j)+gg(l)
14951 end subroutine sc_grad_scale
14952 !-----------------------------------------------------------------------------
14953 ! energy_split-sep.F
14954 !-----------------------------------------------------------------------------
14955 subroutine etotal_long(energia)
14957 ! Compute the long-range slow-varying contributions to the energy
14959 ! implicit real*8 (a-h,o-z)
14960 ! include 'DIMENSIONS'
14961 use MD_data, only: totT,usampl,eq_time
14965 !MS$ATTRIBUTES C :: proc_proc
14970 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
14972 ! include 'COMMON.SETUP'
14973 ! include 'COMMON.IOUNITS'
14974 ! include 'COMMON.FFIELD'
14975 ! include 'COMMON.DERIV'
14976 ! include 'COMMON.INTERACT'
14977 ! include 'COMMON.SBRIDGE'
14978 ! include 'COMMON.CHAIN'
14979 ! include 'COMMON.VAR'
14980 ! include 'COMMON.LOCAL'
14981 ! include 'COMMON.MD'
14982 real(kind=8),dimension(0:n_ene) :: energia
14983 !el local variables
14984 integer :: i,n_corr,n_corr1,ierror,ierr
14985 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
14986 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
14987 ecorr,ecorr5,ecorr6,eturn6,time00
14988 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
14989 !elwrite(iout,*)"in etotal long"
14991 if (modecalc.eq.12.or.modecalc.eq.14) then
14993 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
14995 call int_from_cart1(.false.)
14998 !elwrite(iout,*)"in etotal long"
15001 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
15002 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15004 if (nfgtasks.gt.1) then
15006 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15007 if (fg_rank.eq.0) then
15008 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
15009 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15011 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15012 ! FG slaves as WEIGHTS array.
15019 weights_(7)=wel_loc
15022 weights_(10)=wturn6
15024 weights_(12)=wscloc
15026 weights_(14)=wtor_d
15027 weights_(15)=wstrain
15028 weights_(16)=wvdwpp
15030 weights_(18)=scal14
15031 weights_(21)=wsccor
15032 ! FG Master broadcasts the WEIGHTS_ array
15033 call MPI_Bcast(weights_(1),n_ene,&
15034 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15036 ! FG slaves receive the WEIGHTS array
15037 call MPI_Bcast(weights(1),n_ene,&
15038 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15053 wstrain=weights(15)
15059 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
15061 time_Bcast=time_Bcast+MPI_Wtime()-time00
15062 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
15063 ! call chainbuild_cart
15064 ! call int_from_cart1(.false.)
15066 ! write (iout,*) 'Processor',myrank,
15067 ! & ' calling etotal_short ipot=',ipot
15069 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15071 !d print *,'nnt=',nnt,' nct=',nct
15073 !elwrite(iout,*)"in etotal long"
15074 ! Compute the side-chain and electrostatic interaction energy
15076 goto (101,102,103,104,105,106) ipot
15077 ! Lennard-Jones potential.
15078 101 call elj_long(evdw)
15079 !d print '(a)','Exit ELJ'
15081 ! Lennard-Jones-Kihara potential (shifted).
15082 102 call eljk_long(evdw)
15084 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15085 103 call ebp_long(evdw)
15087 ! Gay-Berne potential (shifted LJ, angular dependence).
15088 104 call egb_long(evdw)
15090 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15091 105 call egbv_long(evdw)
15093 ! Soft-sphere potential
15094 106 call e_softsphere(evdw)
15096 ! Calculate electrostatic (H-bonding) energy of the main chain.
15100 if (ipot.lt.6) then
15102 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
15103 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15104 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15105 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15107 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
15108 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15109 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15110 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15112 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
15121 ! write (iout,*) "Soft-spheer ELEC potential"
15122 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
15126 ! Calculate excluded-volume interaction energy between peptide groups
15129 if (ipot.lt.6) then
15130 if(wscp.gt.0d0) then
15131 call escp_long(evdw2,evdw2_14)
15137 call escp_soft_sphere(evdw2,evdw2_14)
15140 ! 12/1/95 Multi-body terms
15144 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
15145 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
15146 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
15147 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
15148 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
15155 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
15156 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
15159 ! If performing constraint dynamics, call the constraint energy
15160 ! after the equilibration time
15161 if(usampl.and.totT.gt.eq_time) then
15176 energia(2)=evdw2-evdw2_14
15177 energia(18)=evdw2_14
15186 energia(3)=ees+evdw1
15193 energia(8)=eello_turn3
15194 energia(9)=eello_turn4
15196 energia(20)=Uconst+Uconst_back
15197 call sum_energy(energia,.true.)
15198 ! write (iout,*) "Exit ETOTAL_LONG"
15201 end subroutine etotal_long
15202 !-----------------------------------------------------------------------------
15203 subroutine etotal_short(energia)
15205 ! Compute the short-range fast-varying contributions to the energy
15207 ! implicit real*8 (a-h,o-z)
15208 ! include 'DIMENSIONS'
15212 !MS$ATTRIBUTES C :: proc_proc
15217 integer :: ierror,ierr
15218 real(kind=8),dimension(n_ene) :: weights_
15219 real(kind=8) :: time00
15221 ! include 'COMMON.SETUP'
15222 ! include 'COMMON.IOUNITS'
15223 ! include 'COMMON.FFIELD'
15224 ! include 'COMMON.DERIV'
15225 ! include 'COMMON.INTERACT'
15226 ! include 'COMMON.SBRIDGE'
15227 ! include 'COMMON.CHAIN'
15228 ! include 'COMMON.VAR'
15229 ! include 'COMMON.LOCAL'
15230 real(kind=8),dimension(0:n_ene) :: energia
15231 !el local variables
15233 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
15234 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr
15237 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
15239 if (modecalc.eq.12.or.modecalc.eq.14) then
15241 if (fg_rank.eq.0) call int_from_cart1(.false.)
15243 call int_from_cart1(.false.)
15247 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
15248 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15250 if (nfgtasks.gt.1) then
15252 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15253 if (fg_rank.eq.0) then
15254 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
15255 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15257 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15258 ! FG slaves as WEIGHTS array.
15265 weights_(7)=wel_loc
15268 weights_(10)=wturn6
15270 weights_(12)=wscloc
15272 weights_(14)=wtor_d
15273 weights_(15)=wstrain
15274 weights_(16)=wvdwpp
15276 weights_(18)=scal14
15277 weights_(21)=wsccor
15278 ! FG Master broadcasts the WEIGHTS_ array
15279 call MPI_Bcast(weights_(1),n_ene,&
15280 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15282 ! FG slaves receive the WEIGHTS array
15283 call MPI_Bcast(weights(1),n_ene,&
15284 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15299 wstrain=weights(15)
15305 ! write (iout,*),"Processor",myrank," BROADCAST weights"
15306 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
15308 ! write (iout,*) "Processor",myrank," BROADCAST c"
15309 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
15311 ! write (iout,*) "Processor",myrank," BROADCAST dc"
15312 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
15314 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
15315 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
15317 ! write (iout,*) "Processor",myrank," BROADCAST theta"
15318 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
15320 ! write (iout,*) "Processor",myrank," BROADCAST phi"
15321 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
15323 ! write (iout,*) "Processor",myrank," BROADCAST alph"
15324 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
15326 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
15327 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
15329 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
15330 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
15332 time_Bcast=time_Bcast+MPI_Wtime()-time00
15333 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
15335 ! write (iout,*) 'Processor',myrank,
15336 ! & ' calling etotal_short ipot=',ipot
15338 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15340 ! call int_from_cart1(.false.)
15342 ! Compute the side-chain and electrostatic interaction energy
15344 goto (101,102,103,104,105,106) ipot
15345 ! Lennard-Jones potential.
15346 101 call elj_short(evdw)
15347 !d print '(a)','Exit ELJ'
15349 ! Lennard-Jones-Kihara potential (shifted).
15350 102 call eljk_short(evdw)
15352 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15353 103 call ebp_short(evdw)
15355 ! Gay-Berne potential (shifted LJ, angular dependence).
15356 104 call egb_short(evdw)
15358 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15359 105 call egbv_short(evdw)
15361 ! Soft-sphere potential - already dealt with in the long-range part
15363 ! 106 call e_softsphere_short(evdw)
15365 ! Calculate electrostatic (H-bonding) energy of the main chain.
15369 ! Calculate the short-range part of Evdwpp
15371 call evdwpp_short(evdw1)
15373 ! Calculate the short-range part of ESCp
15375 if (ipot.lt.6) then
15376 call escp_short(evdw2,evdw2_14)
15379 ! Calculate the bond-stretching energy
15383 ! Calculate the disulfide-bridge and other energy and the contributions
15384 ! from other distance constraints.
15387 ! Calculate the virtual-bond-angle energy.
15391 ! Calculate the SC local energy.
15396 ! Calculate the virtual-bond torsional energy.
15398 call etor(etors,edihcnstr)
15400 ! 6/23/01 Calculate double-torsional energy
15402 call etor_d(etors_d)
15404 ! 21/5/07 Calculate local sicdechain correlation energy
15406 if (wsccor.gt.0.0d0) then
15407 call eback_sc_corr(esccor)
15412 ! Put energy components into an array
15419 energia(2)=evdw2-evdw2_14
15420 energia(18)=evdw2_14
15433 energia(14)=etors_d
15436 energia(19)=edihcnstr
15438 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
15440 call sum_energy(energia,.true.)
15441 ! write (iout,*) "Exit ETOTAL_SHORT"
15444 end subroutine etotal_short
15445 !-----------------------------------------------------------------------------
15447 !-----------------------------------------------------------------------------
15448 real(kind=8) function gnmr1(y,ymin,ymax)
15450 real(kind=8) :: y,ymin,ymax
15451 real(kind=8) :: wykl=4.0d0
15452 if (y.lt.ymin) then
15453 gnmr1=(ymin-y)**wykl/wykl
15454 else if (y.gt.ymax) then
15455 gnmr1=(y-ymax)**wykl/wykl
15461 !-----------------------------------------------------------------------------
15462 real(kind=8) function gnmr1prim(y,ymin,ymax)
15464 real(kind=8) :: y,ymin,ymax
15465 real(kind=8) :: wykl=4.0d0
15466 if (y.lt.ymin) then
15467 gnmr1prim=-(ymin-y)**(wykl-1)
15468 else if (y.gt.ymax) then
15469 gnmr1prim=(y-ymax)**(wykl-1)
15474 end function gnmr1prim
15475 !-----------------------------------------------------------------------------
15476 real(kind=8) function harmonic(y,ymax)
15478 real(kind=8) :: y,ymax
15479 real(kind=8) :: wykl=2.0d0
15480 harmonic=(y-ymax)**wykl
15482 end function harmonic
15483 !-----------------------------------------------------------------------------
15484 real(kind=8) function harmonicprim(y,ymax)
15485 real(kind=8) :: y,ymin,ymax
15486 real(kind=8) :: wykl=2.0d0
15487 harmonicprim=(y-ymax)*wykl
15489 end function harmonicprim
15490 !-----------------------------------------------------------------------------
15492 !-----------------------------------------------------------------------------
15493 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
15495 use io_base, only:intout,briefout
15496 ! implicit real*8 (a-h,o-z)
15497 ! include 'DIMENSIONS'
15498 ! include 'COMMON.CHAIN'
15499 ! include 'COMMON.DERIV'
15500 ! include 'COMMON.VAR'
15501 ! include 'COMMON.INTERACT'
15502 ! include 'COMMON.FFIELD'
15503 ! include 'COMMON.MD'
15504 ! include 'COMMON.IOUNITS'
15505 real(kind=8),external :: ufparm
15506 integer :: uiparm(1)
15507 real(kind=8) :: urparm(1)
15508 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
15509 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
15510 integer :: n,nf,ind,ind1,i,k,j
15512 ! This subroutine calculates total internal coordinate gradient.
15513 ! Depending on the number of function evaluations, either whole energy
15514 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
15515 ! internal coordinates are reevaluated or only the cartesian-in-internal
15516 ! coordinate derivatives are evaluated. The subroutine was designed to work
15522 !d print *,'grad',nf,icg
15523 if (nf-nfl+1) 20,30,40
15524 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
15525 ! write (iout,*) 'grad 20'
15526 if (nf.eq.0) return
15528 30 call var_to_geom(n,x)
15530 ! write (iout,*) 'grad 30'
15532 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
15535 ! write (iout,*) 'grad 40'
15536 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
15538 ! Convert the Cartesian gradient into internal-coordinate gradient.
15548 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
15550 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
15553 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
15559 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
15561 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
15562 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
15565 if (i.gt.1) g(i-1)=gphii
15566 if (n.gt.nphi) g(nphi+i)=gthetai
15568 if (n.le.nphi+ntheta) goto 10
15570 if (itype(i).ne.10) then
15574 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
15577 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
15579 g(ialph(i,1))=galphai
15580 g(ialph(i,1)+nside)=gomegai
15584 ! Add the components corresponding to local energy terms.
15588 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
15589 g(i)=g(i)+gloc(i,icg)
15591 ! Uncomment following three lines for diagnostics.
15593 !elwrite(iout,*) "in gradient after calling intout"
15594 !d call briefout(0,0.0d0)
15595 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
15597 end subroutine gradient
15598 !-----------------------------------------------------------------------------
15599 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
15602 ! implicit real*8 (a-h,o-z)
15603 ! include 'DIMENSIONS'
15604 ! include 'COMMON.DERIV'
15605 ! include 'COMMON.IOUNITS'
15606 ! include 'COMMON.GEO'
15609 !el common /chuju/ jjj
15610 real(kind=8) :: energia(0:n_ene)
15611 integer :: uiparm(1)
15612 real(kind=8) :: urparm(1)
15614 real(kind=8),external :: ufparm
15615 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
15616 ! if (jjj.gt.0) then
15617 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
15621 !d print *,'func',nf,nfl,icg
15622 call var_to_geom(n,x)
15625 !d write (iout,*) 'ETOTAL called from FUNC'
15626 call etotal(energia)
15629 ! if (jjj.gt.0) then
15630 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
15631 ! write (iout,*) 'f=',etot
15635 end subroutine func
15636 !-----------------------------------------------------------------------------
15637 subroutine cartgrad
15638 ! implicit real*8 (a-h,o-z)
15639 ! include 'DIMENSIONS'
15641 use MD_data, only: totT,usampl,eq_time
15645 ! include 'COMMON.CHAIN'
15646 ! include 'COMMON.DERIV'
15647 ! include 'COMMON.VAR'
15648 ! include 'COMMON.INTERACT'
15649 ! include 'COMMON.FFIELD'
15650 ! include 'COMMON.MD'
15651 ! include 'COMMON.IOUNITS'
15652 ! include 'COMMON.TIME1'
15656 ! This subrouting calculates total Cartesian coordinate gradient.
15657 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
15667 !el write (iout,*) "After sum_gradient"
15669 !el write (iout,*) "After sum_gradient"
15671 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
15672 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
15675 ! If performing constraint dynamics, add the gradients of the constraint energy
15676 if(usampl.and.totT.gt.eq_time) then
15679 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
15680 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
15684 gloc(i,icg)=gloc(i,icg)+dugamma(i)
15687 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
15690 !elwrite (iout,*) "After sum_gradient"
15695 !elwrite (iout,*) "After sum_gradient"
15697 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
15699 ! call checkintcartgrad
15700 ! write(iout,*) 'calling int_to_cart'
15702 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
15706 gcart(j,i)=gradc(j,i,icg)
15707 gxcart(j,i)=gradx(j,i,icg)
15710 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
15711 (gxcart(j,i),j=1,3),gloc(i,icg)
15719 time_inttocart=time_inttocart+MPI_Wtime()-time01
15722 write (iout,*) "gcart and gxcart after int_to_cart"
15724 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
15725 (gxcart(j,i),j=1,3)
15730 write (iout,*) "CARGRAD"
15734 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
15735 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
15737 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
15738 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
15740 ! Correction: dummy residues
15743 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
15744 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
15747 if (nct.lt.nres) then
15749 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
15750 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
15755 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
15759 end subroutine cartgrad
15760 !-----------------------------------------------------------------------------
15761 subroutine zerograd
15762 ! implicit real*8 (a-h,o-z)
15763 ! include 'DIMENSIONS'
15764 ! include 'COMMON.DERIV'
15765 ! include 'COMMON.CHAIN'
15766 ! include 'COMMON.VAR'
15767 ! include 'COMMON.MD'
15768 ! include 'COMMON.SCCOR'
15770 !el local variables
15771 integer :: i,j,intertyp,k
15772 ! Initialize Cartesian-coordinate gradient
15774 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
15775 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
15777 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
15778 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
15779 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
15780 ! allocate(gradcorr_long(3,nres))
15781 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
15782 ! allocate(gcorr6_turn_long(3,nres))
15783 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
15785 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
15787 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
15788 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
15790 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
15791 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
15793 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
15794 ! allocate(gscloc(3,nres)) !(3,maxres)
15795 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
15799 ! common /deriv_scloc/
15800 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
15801 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
15802 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
15804 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
15808 ! gradc(j,i,icg)=0.0d0
15809 ! gradx(j,i,icg)=0.0d0
15811 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
15812 !elwrite(iout,*) "icg",icg
15816 gradx_scp(j,i)=0.0D0
15818 gvdwc_scp(j,i)=0.0D0
15819 gvdwc_scpp(j,i)=0.0d0
15821 gelc_long(j,i)=0.0D0
15826 gel_loc_long(j,i)=0.0d0
15829 gcorr3_turn(j,i)=0.0d0
15830 gcorr4_turn(j,i)=0.0d0
15831 gradcorr(j,i)=0.0d0
15832 gradcorr_long(j,i)=0.0d0
15833 gradcorr5_long(j,i)=0.0d0
15834 gradcorr6_long(j,i)=0.0d0
15835 gcorr6_turn_long(j,i)=0.0d0
15836 gradcorr5(j,i)=0.0d0
15837 gradcorr6(j,i)=0.0d0
15838 gcorr6_turn(j,i)=0.0d0
15841 gradc(j,i,icg)=0.0d0
15842 gradx(j,i,icg)=0.0d0
15845 gliptran(j,i)=0.0d0
15846 gliptranx(j,i)=0.0d0
15847 gliptranc(j,i)=0.0d0
15848 gshieldx(j,i)=0.0d0
15849 gshieldc(j,i)=0.0d0
15850 gshieldc_loc(j,i)=0.0d0
15851 gshieldx_ec(j,i)=0.0d0
15852 gshieldc_ec(j,i)=0.0d0
15853 gshieldc_loc_ec(j,i)=0.0d0
15854 gshieldx_t3(j,i)=0.0d0
15855 gshieldc_t3(j,i)=0.0d0
15856 gshieldc_loc_t3(j,i)=0.0d0
15857 gshieldx_t4(j,i)=0.0d0
15858 gshieldc_t4(j,i)=0.0d0
15859 gshieldc_loc_t4(j,i)=0.0d0
15860 gshieldx_ll(j,i)=0.0d0
15861 gshieldc_ll(j,i)=0.0d0
15862 gshieldc_loc_ll(j,i)=0.0d0
15865 gloc_sc(intertyp,i,icg)=0.0d0
15874 grad_shield_side(k,j,i)=0.0d0
15875 grad_shield_loc(k,j,i)=0.0d0
15882 ! Initialize the gradient of local energy terms.
15884 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
15885 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
15886 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
15887 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
15888 ! allocate(gel_loc_turn3(nres))
15889 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
15890 ! allocate(gsccor_loc(nres)) !(maxres)
15896 gel_loc_loc(i)=0.0d0
15898 g_corr5_loc(i)=0.0d0
15899 g_corr6_loc(i)=0.0d0
15900 gel_loc_turn3(i)=0.0d0
15901 gel_loc_turn4(i)=0.0d0
15902 gel_loc_turn6(i)=0.0d0
15903 gsccor_loc(i)=0.0d0
15905 ! initialize gcart and gxcart
15906 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
15914 end subroutine zerograd
15915 !-----------------------------------------------------------------------------
15916 real(kind=8) function fdum()
15920 !-----------------------------------------------------------------------------
15922 !-----------------------------------------------------------------------------
15923 subroutine intcartderiv
15924 ! implicit real*8 (a-h,o-z)
15925 ! include 'DIMENSIONS'
15929 ! include 'COMMON.SETUP'
15930 ! include 'COMMON.CHAIN'
15931 ! include 'COMMON.VAR'
15932 ! include 'COMMON.GEO'
15933 ! include 'COMMON.INTERACT'
15934 ! include 'COMMON.DERIV'
15935 ! include 'COMMON.IOUNITS'
15936 ! include 'COMMON.LOCAL'
15937 ! include 'COMMON.SCCOR'
15938 real(kind=8) :: pi4,pi34
15939 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
15940 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
15941 dcosomega,dsinomega !(3,3,maxres)
15942 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
15945 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
15946 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
15947 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
15948 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
15952 !el from module energy-------------
15953 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
15954 !el allocate(dsintau(3,3,3,itau_start:itau_end))
15955 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
15957 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
15958 !el allocate(dsintau(3,3,3,0:nres2))
15959 !el allocate(dtauangle(3,3,3,0:nres2))
15960 !el allocate(domicron(3,2,2,0:nres2))
15961 !el allocate(dcosomicron(3,2,2,0:nres2))
15965 #if defined(MPI) && defined(PARINTDER)
15966 if (nfgtasks.gt.1 .and. me.eq.king) &
15967 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
15972 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
15973 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
15975 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
15978 dtheta(j,1,i)=0.0d0
15979 dtheta(j,2,i)=0.0d0
15985 ! Derivatives of theta's
15986 #if defined(MPI) && defined(PARINTDER)
15987 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
15988 do i=max0(ithet_start-1,3),ithet_end
15992 cost=dcos(theta(i))
15993 sint=sqrt(1-cost*cost)
15995 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
15997 if (itype(i-1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
15998 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
16000 if (itype(i-1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
16003 #if defined(MPI) && defined(PARINTDER)
16004 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16005 do i=max0(ithet_start-1,3),ithet_end
16009 if ((itype(i-1).ne.10).and.(itype(i-1).ne.ntyp1)) then
16010 cost1=dcos(omicron(1,i))
16011 sint1=sqrt(1-cost1*cost1)
16012 cost2=dcos(omicron(2,i))
16013 sint2=sqrt(1-cost2*cost2)
16015 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
16016 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
16017 cost1*dc_norm(j,i-2))/ &
16019 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
16020 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
16021 +cost1*(dc_norm(j,i-1+nres)))/ &
16023 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
16024 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
16025 !C Looks messy but better than if in loop
16026 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
16027 +cost2*dc_norm(j,i-1))/ &
16029 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
16030 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
16031 +cost2*(-dc_norm(j,i-1+nres)))/ &
16033 ! write(iout,*) "vbld", i,itype(i),vbld(i-1+nres)
16034 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
16038 !elwrite(iout,*) "after vbld write"
16039 ! Derivatives of phi:
16040 ! If phi is 0 or 180 degrees, then the formulas
16041 ! have to be derived by power series expansion of the
16042 ! conventional formulas around 0 and 180.
16044 do i=iphi1_start,iphi1_end
16048 ! if (itype(i-1).eq.21 .or. itype(i-2).eq.21 ) cycle
16049 ! the conventional case
16050 sint=dsin(theta(i))
16051 sint1=dsin(theta(i-1))
16053 cost=dcos(theta(i))
16054 cost1=dcos(theta(i-1))
16056 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
16057 fac0=1.0d0/(sint1*sint)
16060 fac3=cosg*cost1/(sint1*sint1)
16061 fac4=cosg*cost/(sint*sint)
16062 ! Obtaining the gamma derivatives from sine derivative
16063 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
16064 phi(i).gt.pi34.and.phi(i).le.pi.or. &
16065 phi(i).ge.-pi.and.phi(i).le.-pi34) then
16066 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16067 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
16068 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16072 cosg_inv=1.0d0/cosg
16073 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
16074 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16075 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
16076 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
16078 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
16079 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16080 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
16081 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
16082 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16083 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16084 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
16086 ! Bug fixed 3/24/05 (AL)
16088 ! Obtaining the gamma derivatives from cosine derivative
16091 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
16092 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16093 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16094 dc_norm(j,i-3))/vbld(i-2)
16095 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
16096 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16097 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16099 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
16100 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16101 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16102 dc_norm(j,i-1))/vbld(i)
16103 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
16108 !alculate derivative of Tauangle
16110 do i=itau_start,itau_end
16113 !elwrite(iout,*) " vecpr",i,nres
16115 if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
16116 ! if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10).or.
16117 ! & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1)) cycle
16118 !c dtauangle(j,intertyp,dervityp,residue number)
16119 !c INTERTYP=1 SC...Ca...Ca..Ca
16120 ! the conventional case
16121 sint=dsin(theta(i))
16122 sint1=dsin(omicron(2,i-1))
16123 sing=dsin(tauangle(1,i))
16124 cost=dcos(theta(i))
16125 cost1=dcos(omicron(2,i-1))
16126 cosg=dcos(tauangle(1,i))
16127 !elwrite(iout,*) " vecpr5",i,nres
16129 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
16130 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
16131 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16132 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
16134 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
16135 fac0=1.0d0/(sint1*sint)
16138 fac3=cosg*cost1/(sint1*sint1)
16139 fac4=cosg*cost/(sint*sint)
16140 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
16141 ! Obtaining the gamma derivatives from sine derivative
16142 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
16143 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
16144 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
16145 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16146 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
16147 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16151 cosg_inv=1.0d0/cosg
16152 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16153 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
16154 *vbld_inv(i-2+nres)
16155 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
16156 dsintau(j,1,2,i)= &
16157 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
16158 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16159 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
16160 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
16161 ! Bug fixed 3/24/05 (AL)
16162 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
16163 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16164 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16165 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
16167 ! Obtaining the gamma derivatives from cosine derivative
16170 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16171 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16172 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
16173 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
16174 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16175 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16177 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
16178 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16179 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
16180 dc_norm(j,i-1))/vbld(i)
16181 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
16182 ! write (iout,*) "else",i
16186 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
16189 !C Second case Ca...Ca...Ca...SC
16191 do i=itau_start,itau_end
16195 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
16196 (itype(i-2).eq.ntyp1).or.(itype(i-3).eq.ntyp1)) cycle
16197 ! the conventional case
16198 sint=dsin(omicron(1,i))
16199 sint1=dsin(theta(i-1))
16200 sing=dsin(tauangle(2,i))
16201 cost=dcos(omicron(1,i))
16202 cost1=dcos(theta(i-1))
16203 cosg=dcos(tauangle(2,i))
16205 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16207 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
16208 fac0=1.0d0/(sint1*sint)
16211 fac3=cosg*cost1/(sint1*sint1)
16212 fac4=cosg*cost/(sint*sint)
16213 ! Obtaining the gamma derivatives from sine derivative
16214 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
16215 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
16216 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
16217 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
16218 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
16219 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16223 cosg_inv=1.0d0/cosg
16224 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16225 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
16226 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
16227 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
16228 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
16229 dsintau(j,2,2,i)= &
16230 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
16231 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16232 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
16233 ! & sing*ctgt*domicron(j,1,2,i),
16234 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16235 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
16236 ! Bug fixed 3/24/05 (AL)
16237 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16238 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
16239 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16240 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
16242 ! Obtaining the gamma derivatives from cosine derivative
16245 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16246 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16247 dc_norm(j,i-3))/vbld(i-2)
16248 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
16249 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16250 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16251 dcosomicron(j,1,1,i)
16252 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
16253 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16254 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16255 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16256 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
16257 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
16262 !CC third case SC...Ca...Ca...SC
16265 do i=itau_start,itau_end
16269 ! the conventional case
16270 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
16271 (itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
16272 sint=dsin(omicron(1,i))
16273 sint1=dsin(omicron(2,i-1))
16274 sing=dsin(tauangle(3,i))
16275 cost=dcos(omicron(1,i))
16276 cost1=dcos(omicron(2,i-1))
16277 cosg=dcos(tauangle(3,i))
16279 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16280 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16282 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
16283 fac0=1.0d0/(sint1*sint)
16286 fac3=cosg*cost1/(sint1*sint1)
16287 fac4=cosg*cost/(sint*sint)
16288 ! Obtaining the gamma derivatives from sine derivative
16289 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
16290 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
16291 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
16292 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
16293 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
16294 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16298 cosg_inv=1.0d0/cosg
16299 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16300 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
16301 *vbld_inv(i-2+nres)
16302 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
16303 dsintau(j,3,2,i)= &
16304 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
16305 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16306 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
16307 ! Bug fixed 3/24/05 (AL)
16308 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16309 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
16310 *vbld_inv(i-1+nres)
16311 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16312 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
16314 ! Obtaining the gamma derivatives from cosine derivative
16317 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16318 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16319 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
16320 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
16321 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16322 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16323 dcosomicron(j,1,1,i)
16324 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
16325 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16326 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
16327 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16328 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
16329 ! write(iout,*) "else",i
16335 ! Derivatives of side-chain angles alpha and omega
16336 #if defined(MPI) && defined(PARINTDER)
16337 do i=ibond_start,ibond_end
16341 if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then
16342 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
16345 fac8=fac5/vbld(i+1)
16346 fac9=fac5/vbld(i+nres)
16347 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
16348 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
16349 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
16350 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
16351 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
16352 sina=sqrt(1-cosa*cosa)
16354 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
16356 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
16357 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
16358 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
16359 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
16360 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
16361 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
16362 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
16363 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
16365 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
16367 ! obtaining the derivatives of omega from sines
16368 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
16369 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
16370 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
16371 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
16373 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
16374 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
16375 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
16376 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
16377 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
16378 coso_inv=1.0d0/dcos(omeg(i))
16380 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
16381 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
16382 (sino*dc_norm(j,i-1))/vbld(i)
16383 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
16384 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
16385 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
16386 -sino*dc_norm(j,i)/vbld(i+1)
16387 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
16388 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
16389 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
16391 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
16394 ! obtaining the derivatives of omega from cosines
16395 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
16396 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
16401 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
16402 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
16403 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
16404 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
16405 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
16406 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
16407 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
16408 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
16409 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
16410 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
16411 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
16412 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
16413 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
16414 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
16415 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
16421 dalpha(k,j,i)=0.0d0
16422 domega(k,j,i)=0.0d0
16428 #if defined(MPI) && defined(PARINTDER)
16429 if (nfgtasks.gt.1) then
16431 !d write (iout,*) "Gather dtheta"
16432 !d call flush(iout)
16433 write (iout,*) "dtheta before gather"
16435 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
16438 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
16439 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
16440 king,FG_COMM,IERROR)
16442 !d write (iout,*) "Gather dphi"
16443 !d call flush(iout)
16444 write (iout,*) "dphi before gather"
16446 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
16449 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
16450 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
16451 king,FG_COMM,IERROR)
16452 !d write (iout,*) "Gather dalpha"
16453 !d call flush(iout)
16455 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
16456 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
16457 king,FG_COMM,IERROR)
16458 !d write (iout,*) "Gather domega"
16459 !d call flush(iout)
16460 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
16461 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
16462 king,FG_COMM,IERROR)
16467 write (iout,*) "dtheta after gather"
16469 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
16471 write (iout,*) "dphi after gather"
16473 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
16475 write (iout,*) "dalpha after gather"
16477 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
16479 write (iout,*) "domega after gather"
16481 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
16485 end subroutine intcartderiv
16486 !-----------------------------------------------------------------------------
16487 subroutine checkintcartgrad
16488 ! implicit real*8 (a-h,o-z)
16489 ! include 'DIMENSIONS'
16493 ! include 'COMMON.CHAIN'
16494 ! include 'COMMON.VAR'
16495 ! include 'COMMON.GEO'
16496 ! include 'COMMON.INTERACT'
16497 ! include 'COMMON.DERIV'
16498 ! include 'COMMON.IOUNITS'
16499 ! include 'COMMON.SETUP'
16500 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
16501 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
16502 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
16503 real(kind=8),dimension(3) :: dc_norm_s
16504 real(kind=8) :: aincr=1.0d-5
16506 real(kind=8) :: dcji
16509 theta_s(i)=theta(i)
16513 ! Check theta gradient
16515 "Analytical (upper) and numerical (lower) gradient of theta"
16520 dc(j,i-2)=dcji+aincr
16521 call chainbuild_cart
16522 call int_from_cart1(.false.)
16523 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
16526 dc(j,i-1)=dc(j,i-1)+aincr
16527 call chainbuild_cart
16528 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
16531 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
16532 !el (dtheta(j,2,i),j=1,3)
16533 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
16534 !el (dthetanum(j,2,i),j=1,3)
16535 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
16536 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
16537 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
16540 ! Check gamma gradient
16542 "Analytical (upper) and numerical (lower) gradient of gamma"
16546 dc(j,i-3)=dcji+aincr
16547 call chainbuild_cart
16548 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
16551 dc(j,i-2)=dcji+aincr
16552 call chainbuild_cart
16553 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
16556 dc(j,i-1)=dc(j,i-1)+aincr
16557 call chainbuild_cart
16558 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
16561 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
16562 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
16563 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
16564 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
16565 !el write (iout,'(5x,3(3f10.5,5x))') &
16566 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
16567 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
16568 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
16571 ! Check alpha gradient
16573 "Analytical (upper) and numerical (lower) gradient of alpha"
16575 if(itype(i).ne.10) then
16578 dc(j,i-1)=dcji+aincr
16579 call chainbuild_cart
16580 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
16585 call chainbuild_cart
16586 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
16590 dc(j,i+nres)=dc(j,i+nres)+aincr
16591 call chainbuild_cart
16592 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
16597 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
16598 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
16599 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
16600 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
16601 !el write (iout,'(5x,3(3f10.5,5x))') &
16602 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
16603 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
16604 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
16607 ! Check omega gradient
16609 "Analytical (upper) and numerical (lower) gradient of omega"
16611 if(itype(i).ne.10) then
16614 dc(j,i-1)=dcji+aincr
16615 call chainbuild_cart
16616 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
16621 call chainbuild_cart
16622 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
16626 dc(j,i+nres)=dc(j,i+nres)+aincr
16627 call chainbuild_cart
16628 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
16633 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
16634 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
16635 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
16636 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
16637 !el write (iout,'(5x,3(3f10.5,5x))') &
16638 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
16639 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
16640 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
16644 end subroutine checkintcartgrad
16645 !-----------------------------------------------------------------------------
16647 !-----------------------------------------------------------------------------
16648 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
16649 ! implicit real*8 (a-h,o-z)
16650 ! include 'DIMENSIONS'
16651 ! include 'COMMON.IOUNITS'
16652 ! include 'COMMON.CHAIN'
16653 ! include 'COMMON.INTERACT'
16654 ! include 'COMMON.VAR'
16655 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
16656 integer :: kkk,nsep=3
16657 real(kind=8) :: qm !dist,
16658 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
16659 logical :: lprn=.false.
16661 ! real(kind=8) :: sigm,x
16663 !el sigm(x)=0.25d0*x ! local function
16669 do il=seg1+nsep,seg2
16672 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
16673 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
16674 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
16676 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
16677 if (itype(il).ne.10 .or. itype(jl).ne.10) then
16680 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
16681 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
16682 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
16683 dijCM=dist(il+nres,jl+nres)
16684 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
16686 qq = qq+qqij+qqijCM
16692 if((seg3-il).lt.3) then
16699 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
16700 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
16701 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
16703 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
16704 if (itype(il).ne.10 .or. itype(jl).ne.10) then
16707 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
16708 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
16709 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
16710 dijCM=dist(il+nres,jl+nres)
16711 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
16713 qq = qq+qqij+qqijCM
16718 if (qqmax.le.qq) qqmax=qq
16720 qwolynes=1.0d0-qqmax
16722 end function qwolynes
16723 !-----------------------------------------------------------------------------
16724 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
16725 ! implicit real*8 (a-h,o-z)
16726 ! include 'DIMENSIONS'
16727 ! include 'COMMON.IOUNITS'
16728 ! include 'COMMON.CHAIN'
16729 ! include 'COMMON.INTERACT'
16730 ! include 'COMMON.VAR'
16731 ! include 'COMMON.MD'
16732 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
16733 integer :: nsep=3, kkk
16734 !el real(kind=8) :: dist
16735 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
16736 logical :: lprn=.false.
16738 real(kind=8) :: sim,dd0,fac,ddqij
16739 !el sigm(x)=0.25d0*x ! local function
16749 do il=seg1+nsep,seg2
16752 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
16753 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
16754 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
16756 sim = 1.0d0/sigm(d0ij)
16759 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
16761 ddqij = (c(k,il)-c(k,jl))*fac
16762 dqwol(k,il)=dqwol(k,il)+ddqij
16763 dqwol(k,jl)=dqwol(k,jl)-ddqij
16766 if (itype(il).ne.10 .or. itype(jl).ne.10) then
16769 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
16770 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
16771 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
16772 dijCM=dist(il+nres,jl+nres)
16773 sim = 1.0d0/sigm(d0ijCM)
16776 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
16778 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
16779 dxqwol(k,il)=dxqwol(k,il)+ddqij
16780 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
16787 if((seg3-il).lt.3) then
16794 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
16795 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
16796 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
16798 sim = 1.0d0/sigm(d0ij)
16801 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
16803 ddqij = (c(k,il)-c(k,jl))*fac
16804 dqwol(k,il)=dqwol(k,il)+ddqij
16805 dqwol(k,jl)=dqwol(k,jl)-ddqij
16807 if (itype(il).ne.10 .or. itype(jl).ne.10) then
16810 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
16811 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
16812 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
16813 dijCM=dist(il+nres,jl+nres)
16814 sim = 1.0d0/sigm(d0ijCM)
16817 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
16819 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
16820 dxqwol(k,il)=dxqwol(k,il)+ddqij
16821 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
16830 dqwol(j,i)=dqwol(j,i)/nl
16831 dxqwol(j,i)=dxqwol(j,i)/nl
16835 end subroutine qwolynes_prim
16836 !-----------------------------------------------------------------------------
16837 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
16838 ! implicit real*8 (a-h,o-z)
16839 ! include 'DIMENSIONS'
16840 ! include 'COMMON.IOUNITS'
16841 ! include 'COMMON.CHAIN'
16842 ! include 'COMMON.INTERACT'
16843 ! include 'COMMON.VAR'
16844 integer :: seg1,seg2,seg3,seg4
16846 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
16847 real(kind=8),dimension(3,0:2*nres) :: cdummy
16848 real(kind=8) :: q1,q2
16849 real(kind=8) :: delta=1.0d-10
16854 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
16856 c(j,i)=c(j,i)+delta
16857 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
16858 qwolan(j,i)=(q2-q1)/delta
16864 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
16865 cdummy(j,i+nres)=c(j,i+nres)
16866 c(j,i+nres)=c(j,i+nres)+delta
16867 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
16868 qwolxan(j,i)=(q2-q1)/delta
16869 c(j,i+nres)=cdummy(j,i+nres)
16872 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
16874 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
16876 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
16878 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
16881 end subroutine qwol_num
16882 !-----------------------------------------------------------------------------
16883 subroutine EconstrQ
16884 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
16885 ! implicit real*8 (a-h,o-z)
16886 ! include 'DIMENSIONS'
16887 ! include 'COMMON.CONTROL'
16888 ! include 'COMMON.VAR'
16889 ! include 'COMMON.MD'
16892 ! include 'COMMON.LANGEVIN'
16894 ! include 'COMMON.LANGEVIN.lang0'
16896 ! include 'COMMON.CHAIN'
16897 ! include 'COMMON.DERIV'
16898 ! include 'COMMON.GEO'
16899 ! include 'COMMON.LOCAL'
16900 ! include 'COMMON.INTERACT'
16901 ! include 'COMMON.IOUNITS'
16902 ! include 'COMMON.NAMES'
16903 ! include 'COMMON.TIME1'
16904 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
16905 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
16907 integer :: kstart,kend,lstart,lend,idummy
16908 real(kind=8) :: delta=1.0d-7
16909 integer :: i,j,k,ii
16913 dudconst(j,i)=0.0d0
16914 duxconst(j,i)=0.0d0
16915 dudxconst(j,i)=0.0d0
16920 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
16922 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
16923 ! Calculating the derivatives of Constraint energy with respect to Q
16924 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
16926 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
16927 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
16928 ! hmnum=(hm2-hm1)/delta
16929 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
16930 ! & qinfrag(i,iset))
16931 ! write(iout,*) "harmonicnum frag", hmnum
16932 ! Calculating the derivatives of Q with respect to cartesian coordinates
16933 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
16935 ! write(iout,*) "dqwol "
16937 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
16939 ! write(iout,*) "dxqwol "
16941 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
16943 ! Calculating numerical gradients of dU/dQi and dQi/dxi
16944 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
16945 ! & ,idummy,idummy)
16946 ! The gradients of Uconst in Cs
16949 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
16950 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
16955 kstart=ifrag(1,ipair(1,i,iset),iset)
16956 kend=ifrag(2,ipair(1,i,iset),iset)
16957 lstart=ifrag(1,ipair(2,i,iset),iset)
16958 lend=ifrag(2,ipair(2,i,iset),iset)
16959 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
16960 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
16961 ! Calculating dU/dQ
16962 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
16963 ! hm1=harmonic(qpair(i),qinpair(i,iset))
16964 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
16965 ! hmnum=(hm2-hm1)/delta
16966 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
16967 ! & qinpair(i,iset))
16968 ! write(iout,*) "harmonicnum pair ", hmnum
16969 ! Calculating dQ/dXi
16970 call qwolynes_prim(kstart,kend,.false.,&
16972 ! write(iout,*) "dqwol "
16974 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
16976 ! write(iout,*) "dxqwol "
16978 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
16980 ! Calculating numerical gradients
16981 ! call qwol_num(kstart,kend,.false.
16983 ! The gradients of Uconst in Cs
16986 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
16987 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
16991 ! write(iout,*) "Uconst inside subroutine ", Uconst
16992 ! Transforming the gradients from Cs to dCs for the backbone
16996 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
17000 ! Transforming the gradients from Cs to dCs for the side chains
17003 dudxconst(j,i)=duxconst(j,i)
17006 ! write(iout,*) "dU/ddc backbone "
17008 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
17010 ! write(iout,*) "dU/ddX side chain "
17012 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
17014 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
17015 ! call dEconstrQ_num
17017 end subroutine EconstrQ
17018 !-----------------------------------------------------------------------------
17019 subroutine dEconstrQ_num
17020 ! Calculating numerical dUconst/ddc and dUconst/ddx
17021 ! implicit real*8 (a-h,o-z)
17022 ! include 'DIMENSIONS'
17023 ! include 'COMMON.CONTROL'
17024 ! include 'COMMON.VAR'
17025 ! include 'COMMON.MD'
17028 ! include 'COMMON.LANGEVIN'
17030 ! include 'COMMON.LANGEVIN.lang0'
17032 ! include 'COMMON.CHAIN'
17033 ! include 'COMMON.DERIV'
17034 ! include 'COMMON.GEO'
17035 ! include 'COMMON.LOCAL'
17036 ! include 'COMMON.INTERACT'
17037 ! include 'COMMON.IOUNITS'
17038 ! include 'COMMON.NAMES'
17039 ! include 'COMMON.TIME1'
17040 real(kind=8) :: uzap1,uzap2
17041 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
17042 integer :: kstart,kend,lstart,lend,idummy
17043 real(kind=8) :: delta=1.0d-7
17044 !el local variables
17050 dUcartan(j,i)=0.0d0
17051 cdummy(j,i)=dc(j,i)
17052 dc(j,i)=dc(j,i)+delta
17053 call chainbuild_cart
17056 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17058 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17062 kstart=ifrag(1,ipair(1,ii,iset),iset)
17063 kend=ifrag(2,ipair(1,ii,iset),iset)
17064 lstart=ifrag(1,ipair(2,ii,iset),iset)
17065 lend=ifrag(2,ipair(2,ii,iset),iset)
17066 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17067 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17070 dc(j,i)=cdummy(j,i)
17071 call chainbuild_cart
17074 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17076 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17080 kstart=ifrag(1,ipair(1,ii,iset),iset)
17081 kend=ifrag(2,ipair(1,ii,iset),iset)
17082 lstart=ifrag(1,ipair(2,ii,iset),iset)
17083 lend=ifrag(2,ipair(2,ii,iset),iset)
17084 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17085 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17088 ducartan(j,i)=(uzap2-uzap1)/(delta)
17091 ! Calculating numerical gradients for dU/ddx
17093 duxcartan(j,i)=0.0d0
17095 cdummy(j,i)=dc(j,i+nres)
17096 dc(j,i+nres)=dc(j,i+nres)+delta
17097 call chainbuild_cart
17100 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17102 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17106 kstart=ifrag(1,ipair(1,ii,iset),iset)
17107 kend=ifrag(2,ipair(1,ii,iset),iset)
17108 lstart=ifrag(1,ipair(2,ii,iset),iset)
17109 lend=ifrag(2,ipair(2,ii,iset),iset)
17110 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17111 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17114 dc(j,i+nres)=cdummy(j,i)
17115 call chainbuild_cart
17118 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
17119 ifrag(2,ii,iset),.true.,idummy,idummy)
17120 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17124 kstart=ifrag(1,ipair(1,ii,iset),iset)
17125 kend=ifrag(2,ipair(1,ii,iset),iset)
17126 lstart=ifrag(1,ipair(2,ii,iset),iset)
17127 lend=ifrag(2,ipair(2,ii,iset),iset)
17128 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17129 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17132 duxcartan(j,i)=(uzap2-uzap1)/(delta)
17135 write(iout,*) "Numerical dUconst/ddc backbone "
17137 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
17139 ! write(iout,*) "Numerical dUconst/ddx side-chain "
17141 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
17144 end subroutine dEconstrQ_num
17145 !-----------------------------------------------------------------------------
17147 !-----------------------------------------------------------------------------
17148 subroutine check_energies
17150 ! use random, only: ran_number
17154 ! include 'DIMENSIONS'
17155 ! include 'COMMON.CHAIN'
17156 ! include 'COMMON.VAR'
17157 ! include 'COMMON.IOUNITS'
17158 ! include 'COMMON.SBRIDGE'
17159 ! include 'COMMON.LOCAL'
17160 ! include 'COMMON.GEO'
17162 ! External functions
17163 !EL double precision ran_number
17164 !EL external ran_number
17167 integer :: i,j,k,l,lmax,p,pmax
17168 real(kind=8) :: rmin,rmax
17169 real(kind=8) :: eij
17172 real(kind=8) :: wi,rij,tj,pj
17194 !t wi=ran_number(0.0D0,pi)
17195 ! wi=ran_number(0.0D0,pi/6.0D0)
17197 !t tj=ran_number(0.0D0,pi)
17198 !t pj=ran_number(0.0D0,pi)
17199 ! pj=ran_number(0.0D0,pi/6.0D0)
17203 !t rij=ran_number(rmin,rmax)
17205 c(1,j)=d*sin(pj)*cos(tj)
17206 c(2,j)=d*sin(pj)*sin(tj)
17212 c(3,i)=-rij-d*cos(wi)
17215 dc(k,nres+i)=c(k,nres+i)-c(k,i)
17216 dc_norm(k,nres+i)=dc(k,nres+i)/d
17217 dc(k,nres+j)=c(k,nres+j)-c(k,j)
17218 dc_norm(k,nres+j)=dc(k,nres+j)/d
17221 call dyn_ssbond_ene(i,j,eij)
17226 end subroutine check_energies
17227 !-----------------------------------------------------------------------------
17228 subroutine dyn_ssbond_ene(resi,resj,eij)
17233 ! include 'DIMENSIONS'
17234 ! include 'COMMON.SBRIDGE'
17235 ! include 'COMMON.CHAIN'
17236 ! include 'COMMON.DERIV'
17237 ! include 'COMMON.LOCAL'
17238 ! include 'COMMON.INTERACT'
17239 ! include 'COMMON.VAR'
17240 ! include 'COMMON.IOUNITS'
17241 ! include 'COMMON.CALC'
17245 ! include 'COMMON.MD'
17246 ! use MD, only: totT,t_bath
17249 ! External functions
17250 !EL double precision h_base
17251 !EL external h_base
17254 integer :: resi,resj
17257 real(kind=8) :: eij
17260 logical :: havebond
17261 integer itypi,itypj
17262 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
17263 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
17264 real(kind=8),dimension(3) :: dcosom1,dcosom2
17266 real(kind=8) :: pom1,pom2
17267 real(kind=8) :: ljA,ljB,ljXs
17268 real(kind=8),dimension(1:3) :: d_ljB
17269 real(kind=8) :: ssA,ssB,ssC,ssXs
17270 real(kind=8) :: ssxm,ljxm,ssm,ljm
17271 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
17272 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
17273 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
17274 !-------FIRST METHOD
17276 real(kind=8),dimension(1:3) :: d_xm
17277 !-------END FIRST METHOD
17278 !-------SECOND METHOD
17279 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
17280 !-------END SECOND METHOD
17282 !-------TESTING CODE
17283 !el logical :: checkstop,transgrad
17284 !el common /sschecks/ checkstop,transgrad
17286 integer :: icheck,nicheck,jcheck,njcheck
17287 real(kind=8),dimension(-1:1) :: echeck
17288 real(kind=8) :: deps,ssx0,ljx0
17289 !-------END TESTING CODE
17295 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
17296 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
17299 dxi=dc_norm(1,nres+i)
17300 dyi=dc_norm(2,nres+i)
17301 dzi=dc_norm(3,nres+i)
17302 dsci_inv=vbld_inv(i+nres)
17305 xj=c(1,nres+j)-c(1,nres+i)
17306 yj=c(2,nres+j)-c(2,nres+i)
17307 zj=c(3,nres+j)-c(3,nres+i)
17308 dxj=dc_norm(1,nres+j)
17309 dyj=dc_norm(2,nres+j)
17310 dzj=dc_norm(3,nres+j)
17311 dscj_inv=vbld_inv(j+nres)
17313 chi1=chi(itypi,itypj)
17314 chi2=chi(itypj,itypi)
17321 alf12=0.5D0*(alf1+alf2)
17323 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
17324 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
17325 ! The following are set in sc_angular
17329 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
17330 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
17331 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
17333 rij=1.0D0/rij ! Reset this so it makes sense
17335 sig0ij=sigma(itypi,itypj)
17336 sig=sig0ij*dsqrt(1.0D0/sigsq)
17339 ljA=eps1*eps2rt**2*eps3rt**2
17340 ljB=ljA*bb_aq(itypi,itypj)
17341 ljA=ljA*aa_aq(itypi,itypj)
17342 ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
17347 deltat12=om2-om1+2.0d0
17348 cosphi=om12-om1*om2
17352 +akth*(deltat1*deltat1+deltat2*deltat2) &
17353 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
17354 ssxm=ssXs-0.5D0*ssB/ssA
17356 !-------TESTING CODE
17357 !$$$c Some extra output
17358 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17359 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
17360 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
17361 !$$$ if (ssx0.gt.0.0d0) then
17362 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
17366 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
17367 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
17368 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
17370 !-------END TESTING CODE
17372 !-------TESTING CODE
17373 ! Stop and plot energy and derivative as a function of distance
17374 if (checkstop) then
17375 ssm=ssC-0.25D0*ssB*ssB/ssA
17376 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17377 if (ssm.lt.ljm .and. &
17378 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
17386 if (.not.checkstop) then
17391 do icheck=0,nicheck
17392 do jcheck=-1,njcheck
17393 if (checkstop) rij=(ssxm-1.0d0)+ &
17394 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
17395 !-------END TESTING CODE
17397 if (rij.gt.ljxm) then
17400 fac=(1.0D0/ljd)**expon
17401 e1=fac*fac*aa_aq(itypi,itypj)
17402 e2=fac*bb_aq(itypi,itypj)
17403 eij=eps1*eps2rt*eps3rt*(e1+e2)
17406 eij=eij*eps2rt*eps3rt
17409 e1=e1*eps1*eps2rt**2*eps3rt**2
17410 ed=-expon*(e1+eij)/ljd
17412 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
17413 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
17414 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
17415 -2.0D0*alf12*eps3der+sigder*sigsq_om12
17416 else if (rij.lt.ssxm) then
17419 eij=ssA*ssd*ssd+ssB*ssd+ssC
17421 ed=2*akcm*ssd+akct*deltat12
17423 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
17424 eom1=-2*akth*deltat1-pom1-om2*pom2
17425 eom2= 2*akth*deltat2+pom1-om1*pom2
17428 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
17430 d_ssxm(1)=0.5D0*akct/ssA
17431 d_ssxm(2)=-d_ssxm(1)
17434 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
17435 d_ljxm(2)=d_ljxm(1)*sigsq_om2
17436 d_ljxm(3)=d_ljxm(1)*sigsq_om12
17437 d_ljxm(1)=d_ljxm(1)*sigsq_om1
17439 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
17440 xm=0.5d0*(ssxm+ljxm)
17442 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
17444 if (rij.lt.xm) then
17446 ssm=ssC-0.25D0*ssB*ssB/ssA
17447 d_ssm(1)=0.5D0*akct*ssB/ssA
17448 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
17449 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
17451 f1=(rij-xm)/(ssxm-xm)
17452 f2=(rij-ssxm)/(xm-ssxm)
17456 delta_inv=1.0d0/(xm-ssxm)
17457 deltasq_inv=delta_inv*delta_inv
17459 fac1=deltasq_inv*fac*(xm-rij)
17460 fac2=deltasq_inv*fac*(rij-ssxm)
17461 ed=delta_inv*(Ht*hd2-ssm*hd1)
17462 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
17463 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
17464 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
17467 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17468 d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
17469 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
17470 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
17472 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
17473 f1=(rij-ljxm)/(xm-ljxm)
17474 f2=(rij-xm)/(ljxm-xm)
17478 delta_inv=1.0d0/(ljxm-xm)
17479 deltasq_inv=delta_inv*delta_inv
17481 fac1=deltasq_inv*fac*(ljxm-rij)
17482 fac2=deltasq_inv*fac*(rij-xm)
17483 ed=delta_inv*(ljm*hd2-Ht*hd1)
17484 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
17485 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
17486 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
17488 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
17490 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
17496 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
17497 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
17498 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
17500 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17501 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
17502 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
17503 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
17504 !$$$ d_ssm(3)=omega
17506 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
17508 !$$$ d_ljm(k)=ljm*d_ljB(k)
17512 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
17513 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
17514 !$$$ d_ss(2)=akct*ssd
17515 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
17516 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
17519 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
17520 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
17521 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
17523 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
17524 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
17526 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
17528 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
17529 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
17530 !$$$ h1=h_base(f1,hd1)
17531 !$$$ h2=h_base(f2,hd2)
17532 !$$$ eij=ss*h1+ljf*h2
17533 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
17534 !$$$ deltasq_inv=delta_inv*delta_inv
17535 !$$$ fac=ljf*hd2-ss*hd1
17536 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
17537 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
17538 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
17539 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
17540 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
17541 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
17542 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
17544 !$$$ havebond=.false.
17545 !$$$ if (ed.gt.0.0d0) havebond=.true.
17546 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
17553 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
17554 ! write(iout,'(a15,f12.2,f8.1,2i5)')
17555 ! & "SSBOND_E_FORM",totT,t_bath,i,j
17559 dyn_ssbond_ij(i,j)=eij
17560 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
17561 dyn_ssbond_ij(i,j)=1.0d300
17564 ! write(iout,'(a15,f12.2,f8.1,2i5)')
17565 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
17570 !-------TESTING CODE
17571 !el if (checkstop) then
17572 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
17573 "CHECKSTOP",rij,eij,ed
17577 if (checkstop) then
17578 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
17581 if (checkstop) then
17585 !-------END TESTING CODE
17588 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
17589 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
17592 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
17595 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
17596 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
17597 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
17598 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
17599 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
17600 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
17604 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
17609 gvdwc(l,i)=gvdwc(l,i)-gg(l)
17610 gvdwc(l,j)=gvdwc(l,j)+gg(l)
17614 end subroutine dyn_ssbond_ene
17615 !-----------------------------------------------------------------------------
17616 real(kind=8) function h_base(x,deriv)
17617 ! A smooth function going 0->1 in range [0,1]
17618 ! It should NOT be called outside range [0,1], it will not work there.
17625 real(kind=8) :: deriv
17628 real(kind=8) :: xsq
17631 ! Two parabolas put together. First derivative zero at extrema
17632 !$$$ if (x.lt.0.5D0) then
17633 !$$$ h_base=2.0D0*x*x
17637 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
17638 !$$$ deriv=4.0D0*deriv
17641 ! Third degree polynomial. First derivative zero at extrema
17642 h_base=x*x*(3.0d0-2.0d0*x)
17643 deriv=6.0d0*x*(1.0d0-x)
17645 ! Fifth degree polynomial. First and second derivatives zero at extrema
17647 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
17649 !$$$ deriv=deriv*deriv
17650 !$$$ deriv=30.0d0*xsq*deriv
17653 end function h_base
17654 !-----------------------------------------------------------------------------
17655 subroutine dyn_set_nss
17656 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
17658 use MD_data, only: totT,t_bath
17660 ! include 'DIMENSIONS'
17664 ! include 'COMMON.SBRIDGE'
17665 ! include 'COMMON.CHAIN'
17666 ! include 'COMMON.IOUNITS'
17667 ! include 'COMMON.SETUP'
17668 ! include 'COMMON.MD'
17670 real(kind=8) :: emin
17671 integer :: i,j,imin,ierr
17672 integer :: diff,allnss,newnss
17673 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
17676 integer,dimension(0:nfgtasks) :: i_newnss
17677 integer,dimension(0:nfgtasks) :: displ
17678 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
17679 integer :: g_newnss
17684 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
17693 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
17697 if (allflag(i).eq.0 .and. &
17698 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
17699 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
17703 if (emin.lt.1.0d300) then
17706 if (allflag(i).eq.0 .and. &
17707 (allihpb(i).eq.allihpb(imin) .or. &
17708 alljhpb(i).eq.allihpb(imin) .or. &
17709 allihpb(i).eq.alljhpb(imin) .or. &
17710 alljhpb(i).eq.alljhpb(imin))) then
17717 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
17721 if (allflag(i).eq.1) then
17723 newihpb(newnss)=allihpb(i)
17724 newjhpb(newnss)=alljhpb(i)
17729 if (nfgtasks.gt.1)then
17731 call MPI_Reduce(newnss,g_newnss,1,&
17732 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
17733 call MPI_Gather(newnss,1,MPI_INTEGER,&
17734 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
17736 do i=1,nfgtasks-1,1
17737 displ(i)=i_newnss(i-1)+displ(i-1)
17739 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
17740 g_newihpb,i_newnss,displ,MPI_INTEGER,&
17742 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
17743 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
17745 if(fg_rank.eq.0) then
17746 ! print *,'g_newnss',g_newnss
17747 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
17748 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
17751 newihpb(i)=g_newihpb(i)
17752 newjhpb(i)=g_newjhpb(i)
17760 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
17765 if (idssb(i).eq.newihpb(j) .and. &
17766 jdssb(i).eq.newjhpb(j)) found=.true.
17770 if (.not.found.and.fg_rank.eq.0) &
17771 write(iout,'(a15,f12.2,f8.1,2i5)') &
17772 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
17780 if (newihpb(i).eq.idssb(j) .and. &
17781 newjhpb(i).eq.jdssb(j)) found=.true.
17785 if (.not.found.and.fg_rank.eq.0) &
17786 write(iout,'(a15,f12.2,f8.1,2i5)') &
17787 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
17794 idssb(i)=newihpb(i)
17795 jdssb(i)=newjhpb(i)
17799 end subroutine dyn_set_nss
17800 ! Lipid transfer energy function
17801 subroutine Eliptransfer(eliptran)
17802 !C this is done by Adasko
17803 !C print *,"wchodze"
17804 !C structure of box:
17806 !C--bordliptop-- buffore starts
17807 !C--bufliptop--- here true lipid starts
17809 !C--buflipbot--- lipid ends buffore starts
17810 !C--bordlipbot--buffore ends
17811 real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
17814 print *, "I am in eliptran"
17815 do i=ilip_start,ilip_end
17817 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1).or.(i.eq.nres))&
17820 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
17821 if (positi.le.0.0) positi=positi+boxzsize
17823 !C first for peptide groups
17824 !c for each residue check if it is in lipid or lipid water border area
17825 if ((positi.gt.bordlipbot) &
17826 .and.(positi.lt.bordliptop)) then
17827 !C the energy transfer exist
17828 if (positi.lt.buflipbot) then
17829 !C what fraction I am in
17831 ((positi-bordlipbot)/lipbufthick)
17832 !C lipbufthick is thickenes of lipid buffore
17833 sslip=sscalelip(fracinbuf)
17834 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
17835 eliptran=eliptran+sslip*pepliptran
17836 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
17837 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
17838 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
17840 !C print *,"doing sccale for lower part"
17841 !C print *,i,sslip,fracinbuf,ssgradlip
17842 elseif (positi.gt.bufliptop) then
17843 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
17844 sslip=sscalelip(fracinbuf)
17845 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
17846 eliptran=eliptran+sslip*pepliptran
17847 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
17848 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
17849 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
17850 !C print *, "doing sscalefor top part"
17851 !C print *,i,sslip,fracinbuf,ssgradlip
17853 eliptran=eliptran+pepliptran
17854 !C print *,"I am in true lipid"
17857 !C eliptran=elpitran+0.0 ! I am in water
17859 if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
17861 ! here starts the side chain transfer
17862 do i=ilip_start,ilip_end
17863 if (itype(i).eq.ntyp1) cycle
17864 positi=(mod(c(3,i+nres),boxzsize))
17865 if (positi.le.0) positi=positi+boxzsize
17866 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
17867 !c for each residue check if it is in lipid or lipid water border area
17868 !C respos=mod(c(3,i+nres),boxzsize)
17869 !C print *,positi,bordlipbot,buflipbot
17870 if ((positi.gt.bordlipbot) &
17871 .and.(positi.lt.bordliptop)) then
17872 !C the energy transfer exist
17873 if (positi.lt.buflipbot) then
17875 ((positi-bordlipbot)/lipbufthick)
17876 !C lipbufthick is thickenes of lipid buffore
17877 sslip=sscalelip(fracinbuf)
17878 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
17879 eliptran=eliptran+sslip*liptranene(itype(i))
17880 gliptranx(3,i)=gliptranx(3,i) &
17881 +ssgradlip*liptranene(itype(i))
17882 gliptranc(3,i-1)= gliptranc(3,i-1) &
17883 +ssgradlip*liptranene(itype(i))
17884 !C print *,"doing sccale for lower part"
17885 elseif (positi.gt.bufliptop) then
17887 ((bordliptop-positi)/lipbufthick)
17888 sslip=sscalelip(fracinbuf)
17889 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
17890 eliptran=eliptran+sslip*liptranene(itype(i))
17891 gliptranx(3,i)=gliptranx(3,i) &
17892 +ssgradlip*liptranene(itype(i))
17893 gliptranc(3,i-1)= gliptranc(3,i-1) &
17894 +ssgradlip*liptranene(itype(i))
17895 !C print *, "doing sscalefor top part",sslip,fracinbuf
17897 eliptran=eliptran+liptranene(itype(i))
17898 !C print *,"I am in true lipid"
17900 endif ! if in lipid or buffor
17902 !C eliptran=elpitran+0.0 ! I am in water
17903 if (energy_dec) write(iout,*) i,"eliptran=",eliptran
17906 end subroutine Eliptransfer
17907 !--------------------------------------------------------------------------------
17908 !C first for shielding is setting of function of side-chains
17910 subroutine set_shield_fac2
17911 real(kind=8) :: div77_81=0.974996043d0, &
17912 div4_81=0.2222222222d0
17913 real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
17914 scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
17915 short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
17916 sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
17917 !C the vector between center of side_chain and peptide group
17918 real(kind=8),dimension(3) :: pep_side_long,side_calf, &
17919 pept_group,costhet_grad,cosphi_grad_long, &
17920 cosphi_grad_loc,pep_side_norm,side_calf_norm, &
17921 sh_frac_dist_grad,pep_side
17923 !C write(2,*) "ivec",ivec_start,ivec_end
17925 fac_shield(i)=0.0d0
17927 grad_shield(j,i)=0.0d0
17930 do i=ivec_start,ivec_end
17932 !C if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
17934 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
17935 !Cif there two consequtive dummy atoms there is no peptide group between them
17936 !C the line below has to be changed for FGPROC>1
17939 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
17943 !C first lets set vector conecting the ithe side-chain with kth side-chain
17944 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
17945 !C pep_side(j)=2.0d0
17946 !C and vector conecting the side-chain with its proper calfa
17947 side_calf(j)=c(j,k+nres)-c(j,k)
17948 !C side_calf(j)=2.0d0
17949 pept_group(j)=c(j,i)-c(j,i+1)
17950 !C lets have their lenght
17951 dist_pep_side=pep_side(j)**2+dist_pep_side
17952 dist_side_calf=dist_side_calf+side_calf(j)**2
17953 dist_pept_group=dist_pept_group+pept_group(j)**2
17955 dist_pep_side=sqrt(dist_pep_side)
17956 dist_pept_group=sqrt(dist_pept_group)
17957 dist_side_calf=sqrt(dist_side_calf)
17959 pep_side_norm(j)=pep_side(j)/dist_pep_side
17960 side_calf_norm(j)=dist_side_calf
17962 !C now sscale fraction
17963 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
17964 !C print *,buff_shield,"buff"
17966 if (sh_frac_dist.le.0.0) cycle
17967 !C print *,ishield_list(i),i
17968 !C If we reach here it means that this side chain reaches the shielding sphere
17969 !C Lets add him to the list for gradient
17970 ishield_list(i)=ishield_list(i)+1
17971 !C ishield_list is a list of non 0 side-chain that contribute to factor gradient
17972 !C this list is essential otherwise problem would be O3
17973 shield_list(ishield_list(i),i)=k
17974 !C Lets have the sscale value
17975 if (sh_frac_dist.gt.1.0) then
17976 scale_fac_dist=1.0d0
17978 sh_frac_dist_grad(j)=0.0d0
17981 scale_fac_dist=-sh_frac_dist*sh_frac_dist &
17982 *(2.0d0*sh_frac_dist-3.0d0)
17983 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
17984 /dist_pep_side/buff_shield*0.5d0
17986 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
17987 !C sh_frac_dist_grad(j)=0.0d0
17988 !C scale_fac_dist=1.0d0
17989 !C print *,"jestem",scale_fac_dist,fac_help_scale,
17990 !C & sh_frac_dist_grad(j)
17993 !C this is what is now we have the distance scaling now volume...
17994 short=short_r_sidechain(itype(k))
17995 long=long_r_sidechain(itype(k))
17996 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
17997 sinthet=short/dist_pep_side*costhet
17998 !C now costhet_grad
18001 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
18002 !C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
18003 !C & -short/dist_pep_side**2/costhet)
18004 !C costhet_fac=0.0d0
18006 costhet_grad(j)=costhet_fac*pep_side(j)
18008 !C remember for the final gradient multiply costhet_grad(j)
18009 !C for side_chain by factor -2 !
18010 !C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
18011 !C pep_side0pept_group is vector multiplication
18012 pep_side0pept_group=0.0d0
18014 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
18016 cosalfa=(pep_side0pept_group/ &
18017 (dist_pep_side*dist_side_calf))
18018 fac_alfa_sin=1.0d0-cosalfa**2
18019 fac_alfa_sin=dsqrt(fac_alfa_sin)
18020 rkprim=fac_alfa_sin*(long-short)+short
18023 !C now costhet_grad
18024 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
18026 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
18027 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
18031 cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
18032 +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
18033 *(long-short)/fac_alfa_sin*cosalfa/ &
18034 ((dist_pep_side*dist_side_calf))* &
18035 ((side_calf(j))-cosalfa* &
18036 ((pep_side(j)/dist_pep_side)*dist_side_calf))
18037 !C cosphi_grad_long(j)=0.0d0
18038 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
18039 *(long-short)/fac_alfa_sin*cosalfa &
18040 /((dist_pep_side*dist_side_calf))* &
18042 cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
18043 !C cosphi_grad_loc(j)=0.0d0
18045 !C print *,sinphi,sinthet
18046 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
18049 !C now the gradient...
18051 grad_shield(j,i)=grad_shield(j,i) &
18052 !C gradient po skalowaniu
18053 +(sh_frac_dist_grad(j)*VofOverlap &
18054 !C gradient po costhet
18055 +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
18056 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
18057 sinphi/sinthet*costhet*costhet_grad(j) &
18058 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
18060 !C grad_shield_side is Cbeta sidechain gradient
18061 grad_shield_side(j,ishield_list(i),i)=&
18062 (sh_frac_dist_grad(j)*-2.0d0&
18064 -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
18065 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
18066 sinphi/sinthet*costhet*costhet_grad(j)&
18067 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
18070 grad_shield_loc(j,ishield_list(i),i)= &
18071 scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
18072 (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
18073 sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
18077 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
18079 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
18081 !C write(2,*) "TOTAL VOLUME",i,itype(i),fac_shield(i)
18084 end subroutine set_shield_fac2
18086 !-----------------------------------------------------------------------------
18088 subroutine read_ssHist
18091 ! include 'DIMENSIONS'
18092 ! include "DIMENSIONS.FREE"
18093 ! include 'COMMON.FREE'
18096 character(len=80) :: controlcard
18099 call card_concat(controlcard,.true.)
18100 read(controlcard,*) &
18101 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
18105 end subroutine read_ssHist
18107 !-----------------------------------------------------------------------------
18108 integer function indmat(i,j)
18110 ! get the position of the jth ijth fragment of the chain coordinate system
18111 ! in the fromto array.
18114 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
18116 end function indmat
18117 !-----------------------------------------------------------------------------
18118 real(kind=8) function sigm(x)
18124 !-----------------------------------------------------------------------------
18125 !-----------------------------------------------------------------------------
18126 subroutine alloc_ener_arrays
18127 !EL Allocation of arrays used by module energy
18128 use MD_data, only: mset
18129 !el local variables
18132 if(nres.lt.100) then
18134 elseif(nres.lt.200) then
18135 maxconts=0.8*nres ! Max. number of contacts per residue
18137 maxconts=0.6*nres ! (maxconts=maxres/4)
18139 maxcont=12*nres ! Max. number of SC contacts
18140 maxvar=6*nres ! Max. number of variables
18141 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
18142 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
18143 !----------------------
18144 ! arrays in subroutine init_int_table
18146 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
18147 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
18149 allocate(nint_gr(nres))
18150 allocate(nscp_gr(nres))
18151 allocate(ielstart(nres))
18152 allocate(ielend(nres))
18154 allocate(istart(nres,maxint_gr))
18155 allocate(iend(nres,maxint_gr))
18156 !(maxres,maxint_gr)
18157 allocate(iscpstart(nres,maxint_gr))
18158 allocate(iscpend(nres,maxint_gr))
18159 !(maxres,maxint_gr)
18160 allocate(ielstart_vdw(nres))
18161 allocate(ielend_vdw(nres))
18164 allocate(lentyp(0:nfgtasks-1))
18166 !----------------------
18168 ! common /contacts/
18169 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
18170 allocate(icont(2,maxcont))
18172 ! common /contacts1/
18173 allocate(num_cont(0:nres+4))
18175 allocate(jcont(maxconts,nres))
18177 allocate(facont(maxconts,nres))
18179 allocate(gacont(3,maxconts,nres))
18180 !(3,maxconts,maxres)
18181 ! common /contacts_hb/
18182 allocate(gacontp_hb1(3,maxconts,nres))
18183 allocate(gacontp_hb2(3,maxconts,nres))
18184 allocate(gacontp_hb3(3,maxconts,nres))
18185 allocate(gacontm_hb1(3,maxconts,nres))
18186 allocate(gacontm_hb2(3,maxconts,nres))
18187 allocate(gacontm_hb3(3,maxconts,nres))
18188 allocate(gacont_hbr(3,maxconts,nres))
18189 allocate(grij_hb_cont(3,maxconts,nres))
18190 !(3,maxconts,maxres)
18191 allocate(facont_hb(maxconts,nres))
18193 allocate(ees0p(maxconts,nres))
18194 allocate(ees0m(maxconts,nres))
18195 allocate(d_cont(maxconts,nres))
18196 allocate(ees0plist(maxconts,nres))
18199 allocate(num_cont_hb(nres))
18201 allocate(jcont_hb(maxconts,nres))
18204 allocate(Ug(2,2,nres))
18205 allocate(Ugder(2,2,nres))
18206 allocate(Ug2(2,2,nres))
18207 allocate(Ug2der(2,2,nres))
18209 allocate(obrot(2,nres))
18210 allocate(obrot2(2,nres))
18211 allocate(obrot_der(2,nres))
18212 allocate(obrot2_der(2,nres))
18214 ! common /precomp1/
18215 allocate(mu(2,nres))
18216 allocate(muder(2,nres))
18217 allocate(Ub2(2,nres))
18220 allocate(Ub2der(2,nres))
18221 allocate(Ctobr(2,nres))
18222 allocate(Ctobrder(2,nres))
18223 allocate(Dtobr2(2,nres))
18224 allocate(Dtobr2der(2,nres))
18226 allocate(EUg(2,2,nres))
18227 allocate(EUgder(2,2,nres))
18228 allocate(CUg(2,2,nres))
18229 allocate(CUgder(2,2,nres))
18230 allocate(DUg(2,2,nres))
18231 allocate(Dugder(2,2,nres))
18232 allocate(DtUg2(2,2,nres))
18233 allocate(DtUg2der(2,2,nres))
18235 ! common /precomp2/
18236 allocate(Ug2Db1t(2,nres))
18237 allocate(Ug2Db1tder(2,nres))
18238 allocate(CUgb2(2,nres))
18239 allocate(CUgb2der(2,nres))
18241 allocate(EUgC(2,2,nres))
18242 allocate(EUgCder(2,2,nres))
18243 allocate(EUgD(2,2,nres))
18244 allocate(EUgDder(2,2,nres))
18245 allocate(DtUg2EUg(2,2,nres))
18246 allocate(Ug2DtEUg(2,2,nres))
18248 allocate(Ug2DtEUgder(2,2,2,nres))
18249 allocate(DtUg2EUgder(2,2,2,nres))
18251 ! common /rotat_old/
18252 allocate(costab(nres))
18253 allocate(sintab(nres))
18254 allocate(costab2(nres))
18255 allocate(sintab2(nres))
18258 allocate(a_chuj(2,2,maxconts,nres))
18259 !(2,2,maxconts,maxres)(maxconts=maxres/4)
18260 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
18261 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
18262 ! common /contdistrib/
18263 allocate(ncont_sent(nres))
18264 allocate(ncont_recv(nres))
18266 allocate(iat_sent(nres))
18268 allocate(iint_sent(4,nres,nres))
18269 allocate(iint_sent_local(4,nres,nres))
18271 allocate(iturn3_sent(4,0:nres+4))
18272 allocate(iturn4_sent(4,0:nres+4))
18273 allocate(iturn3_sent_local(4,nres))
18274 allocate(iturn4_sent_local(4,nres))
18276 allocate(itask_cont_from(0:nfgtasks-1))
18277 allocate(itask_cont_to(0:nfgtasks-1))
18278 !(0:max_fg_procs-1)
18282 !----------------------
18285 allocate(dcdv(6,maxdim))
18286 allocate(dxdv(6,maxdim))
18288 allocate(dxds(6,nres))
18290 allocate(gradx(3,-1:nres,0:2))
18291 allocate(gradc(3,-1:nres,0:2))
18293 allocate(gvdwx(3,-1:nres))
18294 allocate(gvdwc(3,-1:nres))
18295 allocate(gelc(3,-1:nres))
18296 allocate(gelc_long(3,-1:nres))
18297 allocate(gvdwpp(3,-1:nres))
18298 allocate(gvdwc_scpp(3,-1:nres))
18299 allocate(gradx_scp(3,-1:nres))
18300 allocate(gvdwc_scp(3,-1:nres))
18301 allocate(ghpbx(3,-1:nres))
18302 allocate(ghpbc(3,-1:nres))
18303 allocate(gradcorr(3,-1:nres))
18304 allocate(gradcorr_long(3,-1:nres))
18305 allocate(gradcorr5_long(3,-1:nres))
18306 allocate(gradcorr6_long(3,-1:nres))
18307 allocate(gcorr6_turn_long(3,-1:nres))
18308 allocate(gradxorr(3,-1:nres))
18309 allocate(gradcorr5(3,-1:nres))
18310 allocate(gradcorr6(3,-1:nres))
18311 allocate(gliptran(3,-1:nres))
18312 allocate(gliptranc(3,-1:nres))
18313 allocate(gliptranx(3,-1:nres))
18314 allocate(gshieldx(3,-1:nres))
18315 allocate(gshieldc(3,-1:nres))
18316 allocate(gshieldc_loc(3,-1:nres))
18317 allocate(gshieldx_ec(3,-1:nres))
18318 allocate(gshieldc_ec(3,-1:nres))
18319 allocate(gshieldc_loc_ec(3,-1:nres))
18320 allocate(gshieldx_t3(3,-1:nres))
18321 allocate(gshieldc_t3(3,-1:nres))
18322 allocate(gshieldc_loc_t3(3,-1:nres))
18323 allocate(gshieldx_t4(3,-1:nres))
18324 allocate(gshieldc_t4(3,-1:nres))
18325 allocate(gshieldc_loc_t4(3,-1:nres))
18326 allocate(gshieldx_ll(3,-1:nres))
18327 allocate(gshieldc_ll(3,-1:nres))
18328 allocate(gshieldc_loc_ll(3,-1:nres))
18329 allocate(grad_shield(3,-1:nres))
18331 allocate(grad_shield_side(3,50,nres))
18332 allocate(grad_shield_loc(3,50,nres))
18333 ! grad for shielding surroing
18334 allocate(gloc(0:maxvar,0:2))
18335 allocate(gloc_x(0:maxvar,2))
18337 allocate(gel_loc(3,-1:nres))
18338 allocate(gel_loc_long(3,-1:nres))
18339 allocate(gcorr3_turn(3,-1:nres))
18340 allocate(gcorr4_turn(3,-1:nres))
18341 allocate(gcorr6_turn(3,-1:nres))
18342 allocate(gradb(3,-1:nres))
18343 allocate(gradbx(3,-1:nres))
18345 allocate(gel_loc_loc(maxvar))
18346 allocate(gel_loc_turn3(maxvar))
18347 allocate(gel_loc_turn4(maxvar))
18348 allocate(gel_loc_turn6(maxvar))
18349 allocate(gcorr_loc(maxvar))
18350 allocate(g_corr5_loc(maxvar))
18351 allocate(g_corr6_loc(maxvar))
18353 allocate(gsccorc(3,-1:nres))
18354 allocate(gsccorx(3,-1:nres))
18356 allocate(gsccor_loc(-1:nres))
18358 allocate(dtheta(3,2,-1:nres))
18360 allocate(gscloc(3,-1:nres))
18361 allocate(gsclocx(3,-1:nres))
18363 allocate(dphi(3,3,-1:nres))
18364 allocate(dalpha(3,3,-1:nres))
18365 allocate(domega(3,3,-1:nres))
18367 ! common /deriv_scloc/
18368 allocate(dXX_C1tab(3,nres))
18369 allocate(dYY_C1tab(3,nres))
18370 allocate(dZZ_C1tab(3,nres))
18371 allocate(dXX_Ctab(3,nres))
18372 allocate(dYY_Ctab(3,nres))
18373 allocate(dZZ_Ctab(3,nres))
18374 allocate(dXX_XYZtab(3,nres))
18375 allocate(dYY_XYZtab(3,nres))
18376 allocate(dZZ_XYZtab(3,nres))
18379 allocate(jgrad_start(nres))
18380 allocate(jgrad_end(nres))
18382 !----------------------
18385 allocate(ibond_displ(0:nfgtasks-1))
18386 allocate(ibond_count(0:nfgtasks-1))
18387 allocate(ithet_displ(0:nfgtasks-1))
18388 allocate(ithet_count(0:nfgtasks-1))
18389 allocate(iphi_displ(0:nfgtasks-1))
18390 allocate(iphi_count(0:nfgtasks-1))
18391 allocate(iphi1_displ(0:nfgtasks-1))
18392 allocate(iphi1_count(0:nfgtasks-1))
18393 allocate(ivec_displ(0:nfgtasks-1))
18394 allocate(ivec_count(0:nfgtasks-1))
18395 allocate(iset_displ(0:nfgtasks-1))
18396 allocate(iset_count(0:nfgtasks-1))
18397 allocate(iint_count(0:nfgtasks-1))
18398 allocate(iint_displ(0:nfgtasks-1))
18399 !(0:max_fg_procs-1)
18400 !----------------------
18403 allocate(gcart(3,-1:nres))
18404 allocate(gxcart(3,-1:nres))
18406 allocate(gradcag(3,-1:nres))
18407 allocate(gradxag(3,-1:nres))
18409 ! common /back_constr/
18410 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
18411 allocate(dutheta(nres))
18412 allocate(dugamma(nres))
18414 allocate(duscdiff(3,nres))
18415 allocate(duscdiffx(3,nres))
18417 !el i io:read_fragments
18418 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
18419 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
18421 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
18422 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
18423 allocate(mset(0:nprocs)) !(maxprocs/20)
18425 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
18426 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
18427 allocate(dUdconst(3,0:nres))
18428 allocate(dUdxconst(3,0:nres))
18429 allocate(dqwol(3,0:nres))
18430 allocate(dxqwol(3,0:nres))
18432 !----------------------
18434 ! common /sbridge/ in io_common: read_bridge
18435 !el allocate((:),allocatable :: iss !(maxss)
18436 ! common /links/ in io_common: read_bridge
18437 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
18438 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
18439 ! common /dyn_ssbond/
18440 ! and side-chain vectors in theta or phi.
18441 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
18445 dyn_ssbond_ij(:,:)=1.0d300
18450 allocate(idssb(nss),jdssb(nss))
18453 allocate(ishield_list(nres))
18454 allocate(shield_list(50,nres))
18455 allocate(dyn_ss_mask(nres))
18456 allocate(fac_shield(nres))
18458 dyn_ss_mask(:)=.false.
18459 !----------------------
18461 ! Parameters of the SCCOR term
18463 !el in io_conf: parmread
18464 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
18465 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
18466 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
18467 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
18468 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
18469 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
18470 ! allocate(vlor1sccor(maxterm_sccor,20,20))
18471 ! allocate(vlor2sccor(maxterm_sccor,20,20))
18472 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
18474 allocate(gloc_sc(3,0:2*nres,0:10))
18475 !(3,0:maxres2,10)maxres2=2*maxres
18476 allocate(dcostau(3,3,3,2*nres))
18477 allocate(dsintau(3,3,3,2*nres))
18478 allocate(dtauangle(3,3,3,2*nres))
18479 allocate(dcosomicron(3,3,3,2*nres))
18480 allocate(domicron(3,3,3,2*nres))
18481 !(3,3,3,maxres2)maxres2=2*maxres
18482 !----------------------
18485 allocate(varall(maxvar))
18486 !(maxvar)(maxvar=6*maxres)
18487 allocate(mask_theta(nres))
18488 allocate(mask_phi(nres))
18489 allocate(mask_side(nres))
18491 !----------------------
18494 allocate(uy(3,nres))
18495 allocate(uz(3,nres))
18497 allocate(uygrad(3,3,2,nres))
18498 allocate(uzgrad(3,3,2,nres))
18502 end subroutine alloc_ener_arrays
18503 !-----------------------------------------------------------------------------
18504 !-----------------------------------------------------------------------------