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,gg_tube,gg_tube_sc !(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,etube
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)
523 if (tubemode.eq.1) then
525 else if (tubemode.eq.2) then
526 call calctube2(etube)
527 elseif (tubemode.eq.3) then
534 time_enecalc=time_enecalc+MPI_Wtime()-time00
536 ! print *,"Processor",myrank," computed Uconstr"
545 energia(2)=evdw2-evdw2_14
562 energia(8)=eello_turn3
563 energia(9)=eello_turn4
570 energia(19)=edihcnstr
572 energia(20)=Uconst+Uconst_back
576 ! Here are the energies showed per procesor if the are more processors
577 ! per molecule then we sum it up in sum_energy subroutine
578 ! print *," Processor",myrank," calls SUM_ENERGY"
579 call sum_energy(energia,.true.)
580 if (dyn_ss) call dyn_set_nss
581 ! print *," Processor",myrank," left SUM_ENERGY"
583 time_sumene=time_sumene+MPI_Wtime()-time00
585 !el call enerprint(energia)
586 !elwrite(iout,*)"finish etotal"
588 end subroutine etotal
589 !-----------------------------------------------------------------------------
590 subroutine sum_energy(energia,reduce)
591 ! implicit real*8 (a-h,o-z)
592 ! include 'DIMENSIONS'
596 !MS$ATTRIBUTES C :: proc_proc
602 ! include 'COMMON.SETUP'
603 ! include 'COMMON.IOUNITS'
604 real(kind=8) :: energia(0:n_ene),enebuff(0:n_ene+1)
605 ! include 'COMMON.FFIELD'
606 ! include 'COMMON.DERIV'
607 ! include 'COMMON.INTERACT'
608 ! include 'COMMON.SBRIDGE'
609 ! include 'COMMON.CHAIN'
610 ! include 'COMMON.VAR'
611 ! include 'COMMON.CONTROL'
612 ! include 'COMMON.TIME1'
614 real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
615 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
616 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot, &
621 real(kind=8) :: time00
622 if (nfgtasks.gt.1 .and. reduce) then
625 write (iout,*) "energies before REDUCE"
626 call enerprint(energia)
630 enebuff(i)=energia(i)
633 call MPI_Barrier(FG_COMM,IERR)
634 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
636 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,&
637 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
639 write (iout,*) "energies after REDUCE"
640 call enerprint(energia)
643 time_Reduce=time_Reduce+MPI_Wtime()-time00
645 if (fg_rank.eq.0) then
649 evdw2=energia(2)+energia(18)
665 eello_turn3=energia(8)
666 eello_turn4=energia(9)
673 edihcnstr=energia(19)
680 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
681 +wang*ebe+wtor*etors+wscloc*escloc &
682 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
683 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
684 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
685 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube
687 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
688 +wang*ebe+wtor*etors+wscloc*escloc &
689 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
690 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
691 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
692 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube
698 if (isnan(etot).ne.0) energia(0)=1.0d+99
700 if (isnan(etot)) energia(0)=1.0d+99
705 idumm=proc_proc(etot,i)
707 call proc_proc(etot,i)
709 if(i.eq.1)energia(0)=1.0d+99
714 ! call enerprint(energia)
717 end subroutine sum_energy
718 !-----------------------------------------------------------------------------
719 subroutine rescale_weights(t_bath)
720 ! implicit real*8 (a-h,o-z)
724 ! include 'DIMENSIONS'
725 ! include 'COMMON.IOUNITS'
726 ! include 'COMMON.FFIELD'
727 ! include 'COMMON.SBRIDGE'
728 real(kind=8) :: kfac=2.4d0
729 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644
731 real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6
732 real(kind=8) :: T0=3.0d2
735 ! facT=2*temp0/(t_bath+temp0)
736 if (rescale_mode.eq.0) then
743 else if (rescale_mode.eq.1) then
744 facT(1)=kfac/(kfac-1.0d0+t_bath/temp0)
745 facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
746 facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
747 facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
748 facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
750 !#if defined(WHAM_RUN) || defined(CLUSTER)
752 ! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
753 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
760 else if (rescale_mode.eq.2) then
766 facT(1)=licznik/dlog(dexp(x)+dexp(-x))
767 facT(2)=licznik/dlog(dexp(x2)+dexp(-x2))
768 facT(3)=licznik/dlog(dexp(x3)+dexp(-x3))
769 facT(4)=licznik/dlog(dexp(x4)+dexp(-x4))
770 facT(5)=licznik/dlog(dexp(x5)+dexp(-x5))
772 !#if defined(WHAM_RUN) || defined(CLUSTER)
774 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
782 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
783 write (*,*) "Wrong RESCALE_MODE",rescale_mode
785 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
789 welec=weights(3)*fact(1)
790 wcorr=weights(4)*fact(3)
791 wcorr5=weights(5)*fact(4)
792 wcorr6=weights(6)*fact(5)
793 wel_loc=weights(7)*fact(2)
794 wturn3=weights(8)*fact(2)
795 wturn4=weights(9)*fact(3)
796 wturn6=weights(10)*fact(5)
797 wtor=weights(13)*fact(1)
798 wtor_d=weights(14)*fact(2)
799 wsccor=weights(21)*fact(1)
802 end subroutine rescale_weights
803 !-----------------------------------------------------------------------------
804 subroutine enerprint(energia)
805 ! implicit real*8 (a-h,o-z)
806 ! include 'DIMENSIONS'
807 ! include 'COMMON.IOUNITS'
808 ! include 'COMMON.FFIELD'
809 ! include 'COMMON.SBRIDGE'
810 ! include 'COMMON.MD'
811 real(kind=8) :: energia(0:n_ene)
813 real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
814 real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
815 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor,eliptran,&
822 evdw2=energia(2)+energia(18)
834 eello_turn3=energia(8)
835 eello_turn4=energia(9)
836 eello_turn6=energia(10)
842 edihcnstr=energia(19)
849 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
850 estr,wbond,ebe,wang,&
851 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
853 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
854 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,&
856 Uconst,eliptran,wliptran,etube,wtube,etot
857 10 format (/'Virtual-chain energies:'// &
858 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
859 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
860 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
861 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ &
862 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
863 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
864 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
865 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
866 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
867 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
868 ' (SS bridges & dist. cnstr.)'/ &
869 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
870 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
871 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
872 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
873 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
874 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
875 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
876 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
877 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
878 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
879 'UCONST= ',1pE16.6,' (Constraint energy)'/ &
880 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/&
881 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
882 'ETOT= ',1pE16.6,' (total)')
884 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
885 estr,wbond,ebe,wang,&
886 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
888 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
889 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
890 ebr*nss,Uconst,eliptran,wliptran,etube,wtube,etot
891 10 format (/'Virtual-chain energies:'// &
892 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
893 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
894 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
895 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
896 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
897 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
898 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
899 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
900 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
901 ' (SS bridges & dist. cnstr.)'/ &
902 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
903 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
904 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
905 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
906 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
907 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
908 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
909 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
910 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
911 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
912 'UCONST=',1pE16.6,' (Constraint energy)'/ &
913 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ &
914 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
915 'ETOT= ',1pE16.6,' (total)')
918 end subroutine enerprint
919 !-----------------------------------------------------------------------------
922 ! This subroutine calculates the interaction energy of nonbonded side chains
923 ! assuming the LJ potential of interaction.
925 ! implicit real*8 (a-h,o-z)
926 ! include 'DIMENSIONS'
927 real(kind=8),parameter :: accur=1.0d-10
928 ! include 'COMMON.GEO'
929 ! include 'COMMON.VAR'
930 ! include 'COMMON.LOCAL'
931 ! include 'COMMON.CHAIN'
932 ! include 'COMMON.DERIV'
933 ! include 'COMMON.INTERACT'
934 ! include 'COMMON.TORSION'
935 ! include 'COMMON.SBRIDGE'
936 ! include 'COMMON.NAMES'
937 ! include 'COMMON.IOUNITS'
938 ! include 'COMMON.CONTACTS'
939 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
942 integer :: i,itypi,iint,j,itypi1,itypj,k
943 real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
944 real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
945 real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
947 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
949 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
950 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
951 ! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
952 ! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
956 if (itypi.eq.ntyp1) cycle
957 itypi1=iabs(itype(i+1))
964 ! Calculate SC interaction energy.
967 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
968 !d & 'iend=',iend(i,iint)
969 do j=istart(i,iint),iend(i,iint)
971 if (itypj.eq.ntyp1) cycle
975 ! Change 12/1/95 to calculate four-body interactions
976 rij=xj*xj+yj*yj+zj*zj
978 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
979 eps0ij=eps(itypi,itypj)
981 e1=fac*fac*aa_aq(itypi,itypj)
982 e2=fac*bb_aq(itypi,itypj)
984 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
985 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
986 !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
987 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
988 !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
989 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
992 ! Calculate the components of the gradient in DC and X
994 fac=-rrij*(e1+evdwij)
999 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1000 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1001 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1002 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1006 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1010 ! 12/1/95, revised on 5/20/97
1012 ! Calculate the contact function. The ith column of the array JCONT will
1013 ! contain the numbers of atoms that make contacts with the atom I (of numbers
1014 ! greater than I). The arrays FACONT and GACONT will contain the values of
1015 ! the contact function and its derivative.
1017 ! Uncomment next line, if the correlation interactions include EVDW explicitly.
1018 ! if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1019 ! Uncomment next line, if the correlation interactions are contact function only
1020 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1022 sigij=sigma(itypi,itypj)
1023 r0ij=rs0(itypi,itypj)
1025 ! Check whether the SC's are not too far to make a contact.
1028 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1029 ! Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1031 if (fcont.gt.0.0D0) then
1032 ! If the SC-SC distance if close to sigma, apply spline.
1033 !Adam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1034 !Adam & fcont1,fprimcont1)
1035 !Adam fcont1=1.0d0-fcont1
1036 !Adam if (fcont1.gt.0.0d0) then
1037 !Adam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1038 !Adam fcont=fcont*fcont1
1040 ! Uncomment following 4 lines to have the geometric average of the epsilon0's
1041 !ga eps0ij=1.0d0/dsqrt(eps0ij)
1043 !ga gg(k)=gg(k)*eps0ij
1045 !ga eps0ij=-evdwij*eps0ij
1046 ! Uncomment for AL's type of SC correlation interactions.
1047 !adam eps0ij=-evdwij
1048 num_conti=num_conti+1
1049 jcont(num_conti,i)=j
1050 facont(num_conti,i)=fcont*eps0ij
1051 fprimcont=eps0ij*fprimcont/rij
1053 !Adam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1054 !Adam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1055 !Adam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1056 ! Uncomment following 3 lines for Skolnick's type of SC correlation.
1057 gacont(1,num_conti,i)=-fprimcont*xj
1058 gacont(2,num_conti,i)=-fprimcont*yj
1059 gacont(3,num_conti,i)=-fprimcont*zj
1060 !d write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1061 !d write (iout,'(2i3,3f10.5)')
1062 !d & i,j,(gacont(kk,num_conti,i),kk=1,3)
1068 num_cont(i)=num_conti
1072 gvdwc(j,i)=expon*gvdwc(j,i)
1073 gvdwx(j,i)=expon*gvdwx(j,i)
1076 !******************************************************************************
1080 ! To save time, the factor of EXPON has been extracted from ALL components
1081 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
1084 !******************************************************************************
1087 !-----------------------------------------------------------------------------
1088 subroutine eljk(evdw)
1090 ! This subroutine calculates the interaction energy of nonbonded side chains
1091 ! assuming the LJK potential of interaction.
1093 ! implicit real*8 (a-h,o-z)
1094 ! include 'DIMENSIONS'
1095 ! include 'COMMON.GEO'
1096 ! include 'COMMON.VAR'
1097 ! include 'COMMON.LOCAL'
1098 ! include 'COMMON.CHAIN'
1099 ! include 'COMMON.DERIV'
1100 ! include 'COMMON.INTERACT'
1101 ! include 'COMMON.IOUNITS'
1102 ! include 'COMMON.NAMES'
1103 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1106 integer :: i,iint,j,itypi,itypi1,k,itypj
1107 real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
1108 real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
1110 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1112 do i=iatsc_s,iatsc_e
1113 itypi=iabs(itype(i))
1114 if (itypi.eq.ntyp1) cycle
1115 itypi1=iabs(itype(i+1))
1120 ! Calculate SC interaction energy.
1122 do iint=1,nint_gr(i)
1123 do j=istart(i,iint),iend(i,iint)
1124 itypj=iabs(itype(j))
1125 if (itypj.eq.ntyp1) cycle
1129 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1130 fac_augm=rrij**expon
1131 e_augm=augm(itypi,itypj)*fac_augm
1132 r_inv_ij=dsqrt(rrij)
1134 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1135 fac=r_shift_inv**expon
1136 e1=fac*fac*aa_aq(itypi,itypj)
1137 e2=fac*bb_aq(itypi,itypj)
1139 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1140 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1141 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1142 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1143 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1144 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1145 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1148 ! Calculate the components of the gradient in DC and X
1150 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1155 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1156 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1157 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1158 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1162 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1170 gvdwc(j,i)=expon*gvdwc(j,i)
1171 gvdwx(j,i)=expon*gvdwx(j,i)
1176 !-----------------------------------------------------------------------------
1177 subroutine ebp(evdw)
1179 ! This subroutine calculates the interaction energy of nonbonded side chains
1180 ! assuming the Berne-Pechukas potential of interaction.
1184 ! implicit real*8 (a-h,o-z)
1185 ! include 'DIMENSIONS'
1186 ! include 'COMMON.GEO'
1187 ! include 'COMMON.VAR'
1188 ! include 'COMMON.LOCAL'
1189 ! include 'COMMON.CHAIN'
1190 ! include 'COMMON.DERIV'
1191 ! include 'COMMON.NAMES'
1192 ! include 'COMMON.INTERACT'
1193 ! include 'COMMON.IOUNITS'
1194 ! include 'COMMON.CALC'
1196 !el integer :: icall
1197 !el common /srutu/ icall
1198 ! double precision rrsave(maxdim)
1201 integer :: iint,itypi,itypi1,itypj
1202 real(kind=8) :: rrij,xi,yi,zi
1203 real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
1205 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1207 ! if (icall.eq.0) then
1213 do i=iatsc_s,iatsc_e
1214 itypi=iabs(itype(i))
1215 if (itypi.eq.ntyp1) cycle
1216 itypi1=iabs(itype(i+1))
1220 dxi=dc_norm(1,nres+i)
1221 dyi=dc_norm(2,nres+i)
1222 dzi=dc_norm(3,nres+i)
1223 ! dsci_inv=dsc_inv(itypi)
1224 dsci_inv=vbld_inv(i+nres)
1226 ! Calculate SC interaction energy.
1228 do iint=1,nint_gr(i)
1229 do j=istart(i,iint),iend(i,iint)
1231 itypj=iabs(itype(j))
1232 if (itypj.eq.ntyp1) cycle
1233 ! dscj_inv=dsc_inv(itypj)
1234 dscj_inv=vbld_inv(j+nres)
1235 chi1=chi(itypi,itypj)
1236 chi2=chi(itypj,itypi)
1243 alf12=0.5D0*(alf1+alf2)
1244 ! For diagnostics only!!!
1257 dxj=dc_norm(1,nres+j)
1258 dyj=dc_norm(2,nres+j)
1259 dzj=dc_norm(3,nres+j)
1260 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1261 !d if (icall.eq.0) then
1267 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
1269 ! Calculate whole angle-dependent part of epsilon and contributions
1270 ! to its derivatives
1271 fac=(rrij*sigsq)**expon2
1272 e1=fac*fac*aa_aq(itypi,itypj)
1273 e2=fac*bb_aq(itypi,itypj)
1274 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1275 eps2der=evdwij*eps3rt
1276 eps3der=evdwij*eps2rt
1277 evdwij=evdwij*eps2rt*eps3rt
1280 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1281 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1282 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1283 !d & restyp(itypi),i,restyp(itypj),j,
1284 !d & epsi,sigm,chi1,chi2,chip1,chip2,
1285 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1286 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
1289 ! Calculate gradient components.
1290 e1=e1*eps1*eps2rt**2*eps3rt**2
1291 fac=-expon*(e1+evdwij)
1294 ! Calculate radial part of the gradient
1298 ! Calculate the angular part of the gradient and sum add the contributions
1299 ! to the appropriate components of the Cartesian gradient.
1307 !-----------------------------------------------------------------------------
1308 subroutine egb(evdw)
1310 ! This subroutine calculates the interaction energy of nonbonded side chains
1311 ! assuming the Gay-Berne potential of interaction.
1314 ! implicit real*8 (a-h,o-z)
1315 ! include 'DIMENSIONS'
1316 ! include 'COMMON.GEO'
1317 ! include 'COMMON.VAR'
1318 ! include 'COMMON.LOCAL'
1319 ! include 'COMMON.CHAIN'
1320 ! include 'COMMON.DERIV'
1321 ! include 'COMMON.NAMES'
1322 ! include 'COMMON.INTERACT'
1323 ! include 'COMMON.IOUNITS'
1324 ! include 'COMMON.CALC'
1325 ! include 'COMMON.CONTROL'
1326 ! include 'COMMON.SBRIDGE'
1329 integer :: iint,itypi,itypi1,itypj,subchap
1330 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
1331 real(kind=8) :: evdw,sig0ij
1332 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
1333 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
1334 sslipi,sslipj,faclip
1336 real(kind=8) :: fracinbuf
1338 !cccc energy_dec=.false.
1339 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1342 ! if (icall.eq.0) lprn=.false.
1344 do i=iatsc_s,iatsc_e
1345 !C print *,"I am in EVDW",i
1346 itypi=iabs(itype(i))
1347 ! if (i.ne.47) cycle
1348 if (itypi.eq.ntyp1) cycle
1349 itypi1=iabs(itype(i+1))
1353 xi=dmod(xi,boxxsize)
1354 if (xi.lt.0) xi=xi+boxxsize
1355 yi=dmod(yi,boxysize)
1356 if (yi.lt.0) yi=yi+boxysize
1357 zi=dmod(zi,boxzsize)
1358 if (zi.lt.0) zi=zi+boxzsize
1360 if ((zi.gt.bordlipbot) &
1361 .and.(zi.lt.bordliptop)) then
1362 !C the energy transfer exist
1363 if (zi.lt.buflipbot) then
1364 !C what fraction I am in
1366 ((zi-bordlipbot)/lipbufthick)
1367 !C lipbufthick is thickenes of lipid buffore
1368 sslipi=sscalelip(fracinbuf)
1369 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1370 elseif (zi.gt.bufliptop) then
1371 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1372 sslipi=sscalelip(fracinbuf)
1373 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1382 print *, sslipi,ssgradlipi
1383 dxi=dc_norm(1,nres+i)
1384 dyi=dc_norm(2,nres+i)
1385 dzi=dc_norm(3,nres+i)
1386 ! dsci_inv=dsc_inv(itypi)
1387 dsci_inv=vbld_inv(i+nres)
1388 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1389 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1391 ! Calculate SC interaction energy.
1393 do iint=1,nint_gr(i)
1394 do j=istart(i,iint),iend(i,iint)
1395 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1396 call dyn_ssbond_ene(i,j,evdwij)
1398 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1399 'evdw',i,j,evdwij,' ss'
1400 ! if (energy_dec) write (iout,*) &
1401 ! 'evdw',i,j,evdwij,' ss'
1404 itypj=iabs(itype(j))
1405 if (itypj.eq.ntyp1) cycle
1406 ! if (j.ne.78) cycle
1407 ! dscj_inv=dsc_inv(itypj)
1408 dscj_inv=vbld_inv(j+nres)
1409 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,&
1410 ! 1.0d0/vbld(j+nres) !d
1411 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1412 sig0ij=sigma(itypi,itypj)
1413 chi1=chi(itypi,itypj)
1414 chi2=chi(itypj,itypi)
1421 alf12=0.5D0*(alf1+alf2)
1422 ! For diagnostics only!!!
1435 xj=dmod(xj,boxxsize)
1436 if (xj.lt.0) xj=xj+boxxsize
1437 yj=dmod(yj,boxysize)
1438 if (yj.lt.0) yj=yj+boxysize
1439 zj=dmod(zj,boxzsize)
1440 if (zj.lt.0) zj=zj+boxzsize
1441 ! print *,"tu",xi,yi,zi,xj,yj,zj
1442 ! print *,"tu2",j,j+nres,c(1,j),c(1,j+nres)
1443 ! this fragment set correct epsilon for lipid phase
1444 if ((zj.gt.bordlipbot) &
1445 .and.(zj.lt.bordliptop)) then
1446 !C the energy transfer exist
1447 if (zj.lt.buflipbot) then
1448 !C what fraction I am in
1450 ((zj-bordlipbot)/lipbufthick)
1451 !C lipbufthick is thickenes of lipid buffore
1452 sslipj=sscalelip(fracinbuf)
1453 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1454 elseif (zj.gt.bufliptop) then
1455 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1456 sslipj=sscalelip(fracinbuf)
1457 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1466 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1467 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1468 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1469 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1470 !------------------------------------------------
1471 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1479 xj=xj_safe+xshift*boxxsize
1480 yj=yj_safe+yshift*boxysize
1481 zj=zj_safe+zshift*boxzsize
1482 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1483 if(dist_temp.lt.dist_init) then
1493 if (subchap.eq.1) then
1502 dxj=dc_norm(1,nres+j)
1503 dyj=dc_norm(2,nres+j)
1504 dzj=dc_norm(3,nres+j)
1505 ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1506 ! write (iout,*) "j",j," dc_norm",& !d
1507 ! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1508 ! write(iout,*)"rrij ",rrij
1509 ! write(iout,*)"xj yj zj ", xj, yj, zj
1510 ! write(iout,*)"xi yi zi ", xi, yi, zi
1511 ! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
1512 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1514 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
1515 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
1516 ! print *,sss_ele_cut,sss_ele_grad,&
1517 ! 1.0d0/(rij),r_cut_ele,rlamb_ele
1518 if (sss_ele_cut.le.0.0) cycle
1519 ! Calculate angle-dependent terms of energy and contributions to their
1523 sig=sig0ij*dsqrt(sigsq)
1524 rij_shift=1.0D0/rij-sig+sig0ij
1525 ! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,&
1527 ! for diagnostics; uncomment
1528 ! rij_shift=1.2*sig0ij
1529 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1530 if (rij_shift.le.0.0D0) then
1532 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1533 !d & restyp(itypi),i,restyp(itypj),j,
1534 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1538 !---------------------------------------------------------------
1539 rij_shift=1.0D0/rij_shift
1540 fac=rij_shift**expon
1542 e1=fac*fac*aa!(itypi,itypj)
1543 e2=fac*bb!(itypi,itypj)
1544 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1545 eps2der=evdwij*eps3rt
1546 eps3der=evdwij*eps2rt
1547 ! write(iout,*)"aa, bb ",aa(:,:),bb(:,:)
1548 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d
1549 ! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d
1550 evdwij=evdwij*eps2rt*eps3rt
1551 evdw=evdw+evdwij*sss_ele_cut
1553 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1554 epsi=bb**2/aa!(itypi,itypj)
1555 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1556 restyp(itypi),i,restyp(itypj),j, &
1557 epsi,sigm,chi1,chi2,chip1,chip2, &
1558 eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
1559 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
1563 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')&
1564 'evdw',i,j,evdwij,xi,xj,rij !,"egb"
1565 !C print *,i,j,c(1,i),c(1,j),c(2,i),c(2,j),c(3,i),c(3,j)
1566 ! if (energy_dec) write (iout,*) &
1569 ! Calculate gradient components.
1570 e1=e1*eps1*eps2rt**2*eps3rt**2
1571 fac=-expon*(e1+evdwij)*rij_shift
1574 ! print *,'before fac',fac,rij,evdwij
1575 fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
1576 /sigma(itypi,itypj)*rij
1577 ! print *,'grad part scale',fac, &
1578 ! evdwij*sss_ele_grad/sss_ele_cut &
1579 ! /sigma(itypi,itypj)*rij
1581 ! Calculate the radial part of the gradient
1585 !C Calculate the radial part of the gradient
1586 gg_lipi(3)=eps1*(eps2rt*eps2rt)&
1587 *(eps3rt*eps3rt)*sss_ele_cut/2.0d0*(faclip*faclip*&
1588 (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))&
1589 +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1590 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1591 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1593 ! print *,'before sc_grad', gg(1),gg(2),gg(3)
1594 ! Calculate angular part of the gradient.
1600 ! write (iout,*) "Number of loop steps in EGB:",ind
1601 !ccc energy_dec=.false.
1604 !-----------------------------------------------------------------------------
1605 subroutine egbv(evdw)
1607 ! This subroutine calculates the interaction energy of nonbonded side chains
1608 ! assuming the Gay-Berne-Vorobjev potential of interaction.
1612 ! implicit real*8 (a-h,o-z)
1613 ! include 'DIMENSIONS'
1614 ! include 'COMMON.GEO'
1615 ! include 'COMMON.VAR'
1616 ! include 'COMMON.LOCAL'
1617 ! include 'COMMON.CHAIN'
1618 ! include 'COMMON.DERIV'
1619 ! include 'COMMON.NAMES'
1620 ! include 'COMMON.INTERACT'
1621 ! include 'COMMON.IOUNITS'
1622 ! include 'COMMON.CALC'
1624 !el integer :: icall
1625 !el common /srutu/ icall
1628 integer :: iint,itypi,itypi1,itypj
1629 real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
1630 real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
1632 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1635 ! if (icall.eq.0) lprn=.true.
1637 do i=iatsc_s,iatsc_e
1638 itypi=iabs(itype(i))
1639 if (itypi.eq.ntyp1) cycle
1640 itypi1=iabs(itype(i+1))
1644 dxi=dc_norm(1,nres+i)
1645 dyi=dc_norm(2,nres+i)
1646 dzi=dc_norm(3,nres+i)
1647 ! dsci_inv=dsc_inv(itypi)
1648 dsci_inv=vbld_inv(i+nres)
1650 ! Calculate SC interaction energy.
1652 do iint=1,nint_gr(i)
1653 do j=istart(i,iint),iend(i,iint)
1655 itypj=iabs(itype(j))
1656 if (itypj.eq.ntyp1) cycle
1657 ! dscj_inv=dsc_inv(itypj)
1658 dscj_inv=vbld_inv(j+nres)
1659 sig0ij=sigma(itypi,itypj)
1660 r0ij=r0(itypi,itypj)
1661 chi1=chi(itypi,itypj)
1662 chi2=chi(itypj,itypi)
1669 alf12=0.5D0*(alf1+alf2)
1670 ! For diagnostics only!!!
1683 dxj=dc_norm(1,nres+j)
1684 dyj=dc_norm(2,nres+j)
1685 dzj=dc_norm(3,nres+j)
1686 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1688 ! Calculate angle-dependent terms of energy and contributions to their
1692 sig=sig0ij*dsqrt(sigsq)
1693 rij_shift=1.0D0/rij-sig+r0ij
1694 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1695 if (rij_shift.le.0.0D0) then
1700 !---------------------------------------------------------------
1701 rij_shift=1.0D0/rij_shift
1702 fac=rij_shift**expon
1703 e1=fac*fac*aa_aq(itypi,itypj)
1704 e2=fac*bb_aq(itypi,itypj)
1705 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1706 eps2der=evdwij*eps3rt
1707 eps3der=evdwij*eps2rt
1708 fac_augm=rrij**expon
1709 e_augm=augm(itypi,itypj)*fac_augm
1710 evdwij=evdwij*eps2rt*eps3rt
1711 evdw=evdw+evdwij+e_augm
1713 sigm=dabs(aa_aq(itypi,itypj)/&
1714 bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1715 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1716 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1717 restyp(itypi),i,restyp(itypj),j,&
1718 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
1719 chi1,chi2,chip1,chip2,&
1720 eps1,eps2rt**2,eps3rt**2,&
1721 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
1724 ! Calculate gradient components.
1725 e1=e1*eps1*eps2rt**2*eps3rt**2
1726 fac=-expon*(e1+evdwij)*rij_shift
1728 fac=rij*fac-2*expon*rrij*e_augm
1729 ! Calculate the radial part of the gradient
1733 ! Calculate angular part of the gradient.
1739 !-----------------------------------------------------------------------------
1740 !el subroutine sc_angular in module geometry
1741 !-----------------------------------------------------------------------------
1742 subroutine e_softsphere(evdw)
1744 ! This subroutine calculates the interaction energy of nonbonded side chains
1745 ! assuming the LJ potential of interaction.
1747 ! implicit real*8 (a-h,o-z)
1748 ! include 'DIMENSIONS'
1749 real(kind=8),parameter :: accur=1.0d-10
1750 ! include 'COMMON.GEO'
1751 ! include 'COMMON.VAR'
1752 ! include 'COMMON.LOCAL'
1753 ! include 'COMMON.CHAIN'
1754 ! include 'COMMON.DERIV'
1755 ! include 'COMMON.INTERACT'
1756 ! include 'COMMON.TORSION'
1757 ! include 'COMMON.SBRIDGE'
1758 ! include 'COMMON.NAMES'
1759 ! include 'COMMON.IOUNITS'
1760 ! include 'COMMON.CONTACTS'
1761 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1762 !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1764 integer :: i,iint,j,itypi,itypi1,itypj,k
1765 real(kind=8) :: evdw,xj,yj,zj,xi,yi,zi,rij,r0ij,r0ijsq,evdwij
1769 do i=iatsc_s,iatsc_e
1770 itypi=iabs(itype(i))
1771 if (itypi.eq.ntyp1) cycle
1772 itypi1=iabs(itype(i+1))
1777 ! Calculate SC interaction energy.
1779 do iint=1,nint_gr(i)
1780 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1781 !d & 'iend=',iend(i,iint)
1782 do j=istart(i,iint),iend(i,iint)
1783 itypj=iabs(itype(j))
1784 if (itypj.eq.ntyp1) cycle
1788 rij=xj*xj+yj*yj+zj*zj
1789 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1790 r0ij=r0(itypi,itypj)
1792 ! print *,i,j,r0ij,dsqrt(rij)
1793 if (rij.lt.r0ijsq) then
1794 evdwij=0.25d0*(rij-r0ijsq)**2
1802 ! Calculate the components of the gradient in DC and X
1808 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1809 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1810 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1811 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1815 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1822 end subroutine e_softsphere
1823 !-----------------------------------------------------------------------------
1824 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1826 ! Soft-sphere potential of p-p interaction
1828 ! implicit real*8 (a-h,o-z)
1829 ! include 'DIMENSIONS'
1830 ! include 'COMMON.CONTROL'
1831 ! include 'COMMON.IOUNITS'
1832 ! include 'COMMON.GEO'
1833 ! include 'COMMON.VAR'
1834 ! include 'COMMON.LOCAL'
1835 ! include 'COMMON.CHAIN'
1836 ! include 'COMMON.DERIV'
1837 ! include 'COMMON.INTERACT'
1838 ! include 'COMMON.CONTACTS'
1839 ! include 'COMMON.TORSION'
1840 ! include 'COMMON.VECTORS'
1841 ! include 'COMMON.FFIELD'
1842 real(kind=8),dimension(3) :: ggg
1843 !d write(iout,*) 'In EELEC_soft_sphere'
1845 integer :: i,j,k,num_conti,iteli,itelj
1846 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
1847 real(kind=8) :: dxi,dyi,dzi,xmedi,ymedi,zmedi,r0ij,r0ijsq
1848 real(kind=8) :: dxj,dyj,dzj,xj,yj,zj,rij,evdw1ij,fac
1856 do i=iatel_s,iatel_e
1857 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1861 xmedi=c(1,i)+0.5d0*dxi
1862 ymedi=c(2,i)+0.5d0*dyi
1863 zmedi=c(3,i)+0.5d0*dzi
1865 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1866 do j=ielstart(i),ielend(i)
1867 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1871 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1872 r0ij=rpp(iteli,itelj)
1877 xj=c(1,j)+0.5D0*dxj-xmedi
1878 yj=c(2,j)+0.5D0*dyj-ymedi
1879 zj=c(3,j)+0.5D0*dzj-zmedi
1880 rij=xj*xj+yj*yj+zj*zj
1881 if (rij.lt.r0ijsq) then
1882 evdw1ij=0.25d0*(rij-r0ijsq)**2
1890 ! Calculate contributions to the Cartesian gradient.
1896 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1897 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1900 ! Loop over residues i+1 thru j-1.
1904 !grad gelc(l,k)=gelc(l,k)+ggg(l)
1909 !grad do i=nnt,nct-1
1911 !grad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1913 !grad do j=i+1,nct-1
1915 !grad gelc(k,i)=gelc(k,i)+gelc(k,j)
1920 end subroutine eelec_soft_sphere
1921 !-----------------------------------------------------------------------------
1922 subroutine vec_and_deriv
1923 ! implicit real*8 (a-h,o-z)
1924 ! include 'DIMENSIONS'
1928 ! include 'COMMON.IOUNITS'
1929 ! include 'COMMON.GEO'
1930 ! include 'COMMON.VAR'
1931 ! include 'COMMON.LOCAL'
1932 ! include 'COMMON.CHAIN'
1933 ! include 'COMMON.VECTORS'
1934 ! include 'COMMON.SETUP'
1935 ! include 'COMMON.TIME1'
1936 real(kind=8),dimension(3,3,2) :: uyder,uzder
1937 real(kind=8),dimension(2) :: vbld_inv_temp
1938 ! Compute the local reference systems. For reference system (i), the
1939 ! X-axis points from CA(i) to CA(i+1), the Y axis is in the
1940 ! CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1943 real(kind=8) :: facy,fac,costh
1946 do i=ivec_start,ivec_end
1950 if (i.eq.nres-1) then
1951 ! Case of the last full residue
1952 ! Compute the Z-axis
1953 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1954 costh=dcos(pi-theta(nres))
1955 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1959 ! Compute the derivatives of uz
1961 uzder(2,1,1)=-dc_norm(3,i-1)
1962 uzder(3,1,1)= dc_norm(2,i-1)
1963 uzder(1,2,1)= dc_norm(3,i-1)
1965 uzder(3,2,1)=-dc_norm(1,i-1)
1966 uzder(1,3,1)=-dc_norm(2,i-1)
1967 uzder(2,3,1)= dc_norm(1,i-1)
1970 uzder(2,1,2)= dc_norm(3,i)
1971 uzder(3,1,2)=-dc_norm(2,i)
1972 uzder(1,2,2)=-dc_norm(3,i)
1974 uzder(3,2,2)= dc_norm(1,i)
1975 uzder(1,3,2)= dc_norm(2,i)
1976 uzder(2,3,2)=-dc_norm(1,i)
1978 ! Compute the Y-axis
1981 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1983 ! Compute the derivatives of uy
1986 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) &
1987 -dc_norm(k,i)*dc_norm(j,i-1)
1988 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1990 uyder(j,j,1)=uyder(j,j,1)-costh
1991 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1996 uygrad(l,k,j,i)=uyder(l,k,j)
1997 uzgrad(l,k,j,i)=uzder(l,k,j)
2001 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2002 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2003 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2004 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2007 ! Compute the Z-axis
2008 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2009 costh=dcos(pi-theta(i+2))
2010 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2014 ! Compute the derivatives of uz
2016 uzder(2,1,1)=-dc_norm(3,i+1)
2017 uzder(3,1,1)= dc_norm(2,i+1)
2018 uzder(1,2,1)= dc_norm(3,i+1)
2020 uzder(3,2,1)=-dc_norm(1,i+1)
2021 uzder(1,3,1)=-dc_norm(2,i+1)
2022 uzder(2,3,1)= dc_norm(1,i+1)
2025 uzder(2,1,2)= dc_norm(3,i)
2026 uzder(3,1,2)=-dc_norm(2,i)
2027 uzder(1,2,2)=-dc_norm(3,i)
2029 uzder(3,2,2)= dc_norm(1,i)
2030 uzder(1,3,2)= dc_norm(2,i)
2031 uzder(2,3,2)=-dc_norm(1,i)
2033 ! Compute the Y-axis
2036 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2038 ! Compute the derivatives of uy
2041 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) &
2042 -dc_norm(k,i)*dc_norm(j,i+1)
2043 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2045 uyder(j,j,1)=uyder(j,j,1)-costh
2046 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2051 uygrad(l,k,j,i)=uyder(l,k,j)
2052 uzgrad(l,k,j,i)=uzder(l,k,j)
2056 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2057 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2058 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2059 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2063 vbld_inv_temp(1)=vbld_inv(i+1)
2064 if (i.lt.nres-1) then
2065 vbld_inv_temp(2)=vbld_inv(i+2)
2067 vbld_inv_temp(2)=vbld_inv(i)
2072 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2073 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2078 #if defined(PARVEC) && defined(MPI)
2079 if (nfgtasks1.gt.1) then
2081 ! print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2082 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2083 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2084 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),&
2085 MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2087 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),&
2088 MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2090 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),&
2091 ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),&
2092 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2093 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),&
2094 ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),&
2095 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2096 time_gather=time_gather+MPI_Wtime()-time00
2098 ! if (fg_rank.eq.0) then
2099 ! write (iout,*) "Arrays UY and UZ"
2101 ! write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2107 end subroutine vec_and_deriv
2108 !-----------------------------------------------------------------------------
2109 subroutine check_vecgrad
2110 ! implicit real*8 (a-h,o-z)
2111 ! include 'DIMENSIONS'
2112 ! include 'COMMON.IOUNITS'
2113 ! include 'COMMON.GEO'
2114 ! include 'COMMON.VAR'
2115 ! include 'COMMON.LOCAL'
2116 ! include 'COMMON.CHAIN'
2117 ! include 'COMMON.VECTORS'
2118 real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
2119 real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
2120 real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
2121 real(kind=8),dimension(3) :: erij
2122 real(kind=8) :: delta=1.0d-7
2128 !rc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2129 !rc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2130 !rc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2131 !d write(iout,'(2i5,2(3f10.5,5x))') i,1,
2132 !d & (dc_norm(if90,i),if90=1,3)
2133 !d write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2134 !d write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2135 !d write(iout,'(a)')
2141 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2142 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2155 !d write (iout,*) 'i=',i
2157 erij(k)=dc_norm(k,i)
2161 dc_norm(k,i)=erij(k)
2163 dc_norm(j,i)=dc_norm(j,i)+delta
2164 ! fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2166 ! dc_norm(k,i)=dc_norm(k,i)/fac
2168 ! write (iout,*) (dc_norm(k,i),k=1,3)
2169 ! write (iout,*) (erij(k),k=1,3)
2172 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2173 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2174 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2175 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2177 ! write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2178 ! & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2179 ! & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2182 dc_norm(k,i)=erij(k)
2185 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2186 !d & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2187 !d & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2188 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2189 !d & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2190 !d & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2191 !d write (iout,'(a)')
2195 end subroutine check_vecgrad
2196 !-----------------------------------------------------------------------------
2197 subroutine set_matrices
2198 ! implicit real*8 (a-h,o-z)
2199 ! include 'DIMENSIONS'
2202 ! include "COMMON.SETUP"
2204 integer :: status(MPI_STATUS_SIZE)
2206 ! include 'COMMON.IOUNITS'
2207 ! include 'COMMON.GEO'
2208 ! include 'COMMON.VAR'
2209 ! include 'COMMON.LOCAL'
2210 ! include 'COMMON.CHAIN'
2211 ! include 'COMMON.DERIV'
2212 ! include 'COMMON.INTERACT'
2213 ! include 'COMMON.CONTACTS'
2214 ! include 'COMMON.TORSION'
2215 ! include 'COMMON.VECTORS'
2216 ! include 'COMMON.FFIELD'
2217 real(kind=8) :: auxvec(2),auxmat(2,2)
2218 integer :: i,iti1,iti,k,l
2219 real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2
2220 ! print *,"in set matrices"
2222 ! Compute the virtual-bond-torsional-angle dependent quantities needed
2223 ! to calculate the el-loc multibody terms of various order.
2227 do i=ivec_start+2,ivec_end+2
2232 if (i .lt. nres+1) then
2269 if (i .gt. 3 .and. i .lt. nres+1) then
2270 obrot_der(1,i-2)=-sin1
2271 obrot_der(2,i-2)= cos1
2272 Ugder(1,1,i-2)= sin1
2273 Ugder(1,2,i-2)=-cos1
2274 Ugder(2,1,i-2)=-cos1
2275 Ugder(2,2,i-2)=-sin1
2278 obrot2_der(1,i-2)=-dwasin2
2279 obrot2_der(2,i-2)= dwacos2
2280 Ug2der(1,1,i-2)= dwasin2
2281 Ug2der(1,2,i-2)=-dwacos2
2282 Ug2der(2,1,i-2)=-dwacos2
2283 Ug2der(2,2,i-2)=-dwasin2
2285 obrot_der(1,i-2)=0.0d0
2286 obrot_der(2,i-2)=0.0d0
2287 Ugder(1,1,i-2)=0.0d0
2288 Ugder(1,2,i-2)=0.0d0
2289 Ugder(2,1,i-2)=0.0d0
2290 Ugder(2,2,i-2)=0.0d0
2291 obrot2_der(1,i-2)=0.0d0
2292 obrot2_der(2,i-2)=0.0d0
2293 Ug2der(1,1,i-2)=0.0d0
2294 Ug2der(1,2,i-2)=0.0d0
2295 Ug2der(2,1,i-2)=0.0d0
2296 Ug2der(2,2,i-2)=0.0d0
2298 ! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2299 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2300 iti = itortyp(itype(i-2))
2304 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2305 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2306 iti1 = itortyp(itype(i-1))
2310 ! print *,iti,i,"iti",iti1,itype(i-1),itype(i-2)
2311 !d write (iout,*) '*******i',i,' iti1',iti
2312 !d write (iout,*) 'b1',b1(:,iti)
2313 !d write (iout,*) 'b2',b2(:,iti)
2314 !d write (iout,*) 'Ug',Ug(:,:,i-2)
2315 ! if (i .gt. iatel_s+2) then
2316 if (i .gt. nnt+2) then
2317 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2318 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2319 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2321 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2322 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2323 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2324 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2325 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2336 DtUg2(l,k,i-2)=0.0d0
2340 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2341 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2343 muder(k,i-2)=Ub2der(k,i-2)
2345 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2346 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2347 if (itype(i-1).le.ntyp) then
2348 iti1 = itortyp(itype(i-1))
2356 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2358 ! if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
2359 ! if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,iti1)
2360 ! if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
2361 !d write (iout,*) 'mu1',mu1(:,i-2)
2362 !d write (iout,*) 'mu2',mu2(:,i-2)
2363 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2365 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2366 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2367 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2368 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2369 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2370 ! Vectors and matrices dependent on a single virtual-bond dihedral.
2371 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2372 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2373 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2374 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2375 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2376 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2377 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2378 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2379 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2382 ! Matrices dependent on two consecutive virtual-bond dihedrals.
2383 ! The order of matrices is from left to right.
2384 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2386 ! do i=max0(ivec_start,2),ivec_end
2388 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2389 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2390 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2391 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2392 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2393 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2394 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2395 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2398 #if defined(MPI) && defined(PARMAT)
2400 ! if (fg_rank.eq.0) then
2401 write (iout,*) "Arrays UG and UGDER before GATHER"
2403 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2404 ((ug(l,k,i),l=1,2),k=1,2),&
2405 ((ugder(l,k,i),l=1,2),k=1,2)
2407 write (iout,*) "Arrays UG2 and UG2DER"
2409 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2410 ((ug2(l,k,i),l=1,2),k=1,2),&
2411 ((ug2der(l,k,i),l=1,2),k=1,2)
2413 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2415 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2416 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2417 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2419 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2421 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2422 costab(i),sintab(i),costab2(i),sintab2(i)
2424 write (iout,*) "Array MUDER"
2426 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2430 if (nfgtasks.gt.1) then
2432 ! write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2433 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2434 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2436 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),&
2437 MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2439 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),&
2440 MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2442 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),&
2443 MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2445 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),&
2446 MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2448 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),&
2449 MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2451 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),&
2452 MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2454 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),&
2455 MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),&
2456 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2457 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),&
2458 MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),&
2459 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2460 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),&
2461 MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),&
2462 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2463 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),&
2464 MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),&
2465 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2466 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2468 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),&
2469 MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2471 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),&
2472 MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2474 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),&
2475 MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2477 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),&
2478 MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2480 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),&
2481 MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2483 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),&
2484 ivec_count(fg_rank1),&
2485 MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2487 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),&
2488 MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2490 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),&
2491 MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2493 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),&
2494 MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2496 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),&
2497 MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2499 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),&
2500 MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2502 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),&
2503 MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2505 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),&
2506 MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2508 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),&
2509 ivec_count(fg_rank1),&
2510 MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2512 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),&
2513 MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2515 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),&
2516 MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2518 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),&
2519 MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2521 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),&
2522 MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2524 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),&
2525 ivec_count(fg_rank1),&
2526 MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2528 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),&
2529 ivec_count(fg_rank1),&
2530 MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2532 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),&
2533 ivec_count(fg_rank1),&
2534 MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2535 MPI_MAT2,FG_COMM1,IERR)
2536 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),&
2537 ivec_count(fg_rank1),&
2538 MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2539 MPI_MAT2,FG_COMM1,IERR)
2542 ! Passes matrix info through the ring
2545 if (irecv.lt.0) irecv=nfgtasks1-1
2548 if (inext.ge.nfgtasks1) inext=0
2550 ! write (iout,*) "isend",isend," irecv",irecv
2552 lensend=lentyp(isend)
2553 lenrecv=lentyp(irecv)
2554 ! write (iout,*) "lensend",lensend," lenrecv",lenrecv
2555 ! call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2556 ! & MPI_ROTAT1(lensend),inext,2200+isend,
2557 ! & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2558 ! & iprev,2200+irecv,FG_COMM,status,IERR)
2559 ! write (iout,*) "Gather ROTAT1"
2561 ! call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2562 ! & MPI_ROTAT2(lensend),inext,3300+isend,
2563 ! & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2564 ! & iprev,3300+irecv,FG_COMM,status,IERR)
2565 ! write (iout,*) "Gather ROTAT2"
2567 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,&
2568 MPI_ROTAT_OLD(lensend),inext,4400+isend,&
2569 costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),&
2570 iprev,4400+irecv,FG_COMM,status,IERR)
2571 ! write (iout,*) "Gather ROTAT_OLD"
2573 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,&
2574 MPI_PRECOMP11(lensend),inext,5500+isend,&
2575 mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),&
2576 iprev,5500+irecv,FG_COMM,status,IERR)
2577 ! write (iout,*) "Gather PRECOMP11"
2579 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,&
2580 MPI_PRECOMP12(lensend),inext,6600+isend,&
2581 Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),&
2582 iprev,6600+irecv,FG_COMM,status,IERR)
2583 ! write (iout,*) "Gather PRECOMP12"
2585 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2587 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,&
2588 MPI_ROTAT2(lensend),inext,7700+isend,&
2589 ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),&
2590 iprev,7700+irecv,FG_COMM,status,IERR)
2591 ! write (iout,*) "Gather PRECOMP21"
2593 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,&
2594 MPI_PRECOMP22(lensend),inext,8800+isend,&
2595 EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),&
2596 iprev,8800+irecv,FG_COMM,status,IERR)
2597 ! write (iout,*) "Gather PRECOMP22"
2599 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,&
2600 MPI_PRECOMP23(lensend),inext,9900+isend,&
2601 Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,&
2602 MPI_PRECOMP23(lenrecv),&
2603 iprev,9900+irecv,FG_COMM,status,IERR)
2604 ! write (iout,*) "Gather PRECOMP23"
2609 if (irecv.lt.0) irecv=nfgtasks1-1
2612 time_gather=time_gather+MPI_Wtime()-time00
2615 ! if (fg_rank.eq.0) then
2616 write (iout,*) "Arrays UG and UGDER"
2618 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2619 ((ug(l,k,i),l=1,2),k=1,2),&
2620 ((ugder(l,k,i),l=1,2),k=1,2)
2622 write (iout,*) "Arrays UG2 and UG2DER"
2624 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2625 ((ug2(l,k,i),l=1,2),k=1,2),&
2626 ((ug2der(l,k,i),l=1,2),k=1,2)
2628 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2630 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2631 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2632 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2634 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2636 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2637 costab(i),sintab(i),costab2(i),sintab2(i)
2639 write (iout,*) "Array MUDER"
2641 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2647 !d iti = itortyp(itype(i))
2650 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2651 !d & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2655 end subroutine set_matrices
2656 !-----------------------------------------------------------------------------
2657 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2659 ! This subroutine calculates the average interaction energy and its gradient
2660 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
2661 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2662 ! The potential depends both on the distance of peptide-group centers and on
2663 ! the orientation of the CA-CA virtual bonds.
2666 ! implicit real*8 (a-h,o-z)
2670 ! include 'DIMENSIONS'
2671 ! include 'COMMON.CONTROL'
2672 ! include 'COMMON.SETUP'
2673 ! include 'COMMON.IOUNITS'
2674 ! include 'COMMON.GEO'
2675 ! include 'COMMON.VAR'
2676 ! include 'COMMON.LOCAL'
2677 ! include 'COMMON.CHAIN'
2678 ! include 'COMMON.DERIV'
2679 ! include 'COMMON.INTERACT'
2680 ! include 'COMMON.CONTACTS'
2681 ! include 'COMMON.TORSION'
2682 ! include 'COMMON.VECTORS'
2683 ! include 'COMMON.FFIELD'
2684 ! include 'COMMON.TIME1'
2685 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
2686 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2687 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2688 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2689 real(kind=8),dimension(4) :: muij
2690 !el integer :: num_conti,j1,j2
2691 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2692 !el dz_normi,xmedi,ymedi,zmedi
2694 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2695 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
2698 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2700 real(kind=8) :: scal_el=1.0d0
2702 real(kind=8) :: scal_el=0.5d0
2705 ! 13-go grudnia roku pamietnego...
2706 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
2708 0.0d0,0.0d0,1.0d0/),shape(unmat))
2711 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2712 real(kind=8) :: fac,t_eelecij,fracinbuf
2715 !d write(iout,*) 'In EELEC'
2716 ! print *,"IN EELEC"
2718 !d write(iout,*) 'Type',i
2719 !d write(iout,*) 'B1',B1(:,i)
2720 !d write(iout,*) 'B2',B2(:,i)
2721 !d write(iout,*) 'CC',CC(:,:,i)
2722 !d write(iout,*) 'DD',DD(:,:,i)
2723 !d write(iout,*) 'EE',EE(:,:,i)
2725 !d call check_vecgrad
2740 if (icheckgrad.eq.1) then
2743 ! dc_norm(1,i)=0.0d0
2744 ! dc_norm(2,i)=0.0d0
2745 ! dc_norm(3,i)=0.0d0
2748 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2750 dc_norm(k,i)=dc(k,i)*fac
2752 ! write (iout,*) 'i',i,' fac',fac
2755 print *,wel_loc,"wel_loc",wcorr4,wcorr5,wcorr6,wturn3,wturn4, &
2757 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
2758 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
2759 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2760 ! call vec_and_deriv
2764 ! print *, "before set matrices"
2766 ! print *, "after set matrices"
2769 time_mat=time_mat+MPI_Wtime()-time01
2772 ! print *, "after set matrices"
2774 !d write (iout,*) 'i=',i
2776 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2779 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2780 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2793 !d print '(a)','Enter EELEC'
2794 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2795 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
2796 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
2798 gel_loc_loc(i)=0.0d0
2803 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2805 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
2809 ! print *,"before iturn3 loop"
2810 do i=iturn3_start,iturn3_end
2811 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
2812 .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2816 dx_normi=dc_norm(1,i)
2817 dy_normi=dc_norm(2,i)
2818 dz_normi=dc_norm(3,i)
2819 xmedi=c(1,i)+0.5d0*dxi
2820 ymedi=c(2,i)+0.5d0*dyi
2821 zmedi=c(3,i)+0.5d0*dzi
2822 xmedi=dmod(xmedi,boxxsize)
2823 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2824 ymedi=dmod(ymedi,boxysize)
2825 if (ymedi.lt.0) ymedi=ymedi+boxysize
2826 zmedi=dmod(zmedi,boxzsize)
2827 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2829 if ((zmedi.gt.bordlipbot) &
2830 .and.(zmedi.lt.bordliptop)) then
2831 !C the energy transfer exist
2832 if (zmedi.lt.buflipbot) then
2833 !C what fraction I am in
2835 ((zmedi-bordlipbot)/lipbufthick)
2836 !C lipbufthick is thickenes of lipid buffore
2837 sslipi=sscalelip(fracinbuf)
2838 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
2839 elseif (zmedi.gt.bufliptop) then
2840 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
2841 sslipi=sscalelip(fracinbuf)
2842 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
2851 ! print *,i,sslipi,ssgradlipi
2852 call eelecij(i,i+2,ees,evdw1,eel_loc)
2853 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2854 num_cont_hb(i)=num_conti
2856 do i=iturn4_start,iturn4_end
2857 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
2858 .or. itype(i+3).eq.ntyp1 &
2859 .or. itype(i+4).eq.ntyp1) cycle
2863 dx_normi=dc_norm(1,i)
2864 dy_normi=dc_norm(2,i)
2865 dz_normi=dc_norm(3,i)
2866 xmedi=c(1,i)+0.5d0*dxi
2867 ymedi=c(2,i)+0.5d0*dyi
2868 zmedi=c(3,i)+0.5d0*dzi
2869 xmedi=dmod(xmedi,boxxsize)
2870 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2871 ymedi=dmod(ymedi,boxysize)
2872 if (ymedi.lt.0) ymedi=ymedi+boxysize
2873 zmedi=dmod(zmedi,boxzsize)
2874 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2875 if ((zmedi.gt.bordlipbot) &
2876 .and.(zmedi.lt.bordliptop)) then
2877 !C the energy transfer exist
2878 if (zmedi.lt.buflipbot) then
2879 !C what fraction I am in
2881 ((zmedi-bordlipbot)/lipbufthick)
2882 !C lipbufthick is thickenes of lipid buffore
2883 sslipi=sscalelip(fracinbuf)
2884 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
2885 elseif (zmedi.gt.bufliptop) then
2886 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
2887 sslipi=sscalelip(fracinbuf)
2888 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
2898 num_conti=num_cont_hb(i)
2899 call eelecij(i,i+3,ees,evdw1,eel_loc)
2900 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
2901 call eturn4(i,eello_turn4)
2902 num_cont_hb(i)=num_conti
2905 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2907 do i=iatel_s,iatel_e
2908 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2912 dx_normi=dc_norm(1,i)
2913 dy_normi=dc_norm(2,i)
2914 dz_normi=dc_norm(3,i)
2915 xmedi=c(1,i)+0.5d0*dxi
2916 ymedi=c(2,i)+0.5d0*dyi
2917 zmedi=c(3,i)+0.5d0*dzi
2918 xmedi=dmod(xmedi,boxxsize)
2919 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2920 ymedi=dmod(ymedi,boxysize)
2921 if (ymedi.lt.0) ymedi=ymedi+boxysize
2922 zmedi=dmod(zmedi,boxzsize)
2923 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2924 if ((zmedi.gt.bordlipbot) &
2925 .and.(zmedi.lt.bordliptop)) then
2926 !C the energy transfer exist
2927 if (zmedi.lt.buflipbot) then
2928 !C what fraction I am in
2930 ((zmedi-bordlipbot)/lipbufthick)
2931 !C lipbufthick is thickenes of lipid buffore
2932 sslipi=sscalelip(fracinbuf)
2933 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
2934 elseif (zmedi.gt.bufliptop) then
2935 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
2936 sslipi=sscalelip(fracinbuf)
2937 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
2947 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2948 num_conti=num_cont_hb(i)
2949 do j=ielstart(i),ielend(i)
2950 ! write (iout,*) i,j,itype(i),itype(j)
2951 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2952 call eelecij(i,j,ees,evdw1,eel_loc)
2954 num_cont_hb(i)=num_conti
2956 ! write (iout,*) "Number of loop steps in EELEC:",ind
2958 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
2959 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2961 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2962 !cc eel_loc=eel_loc+eello_turn3
2963 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
2965 end subroutine eelec
2966 !-----------------------------------------------------------------------------
2967 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2970 ! implicit real*8 (a-h,o-z)
2971 ! include 'DIMENSIONS'
2975 ! include 'COMMON.CONTROL'
2976 ! include 'COMMON.IOUNITS'
2977 ! include 'COMMON.GEO'
2978 ! include 'COMMON.VAR'
2979 ! include 'COMMON.LOCAL'
2980 ! include 'COMMON.CHAIN'
2981 ! include 'COMMON.DERIV'
2982 ! include 'COMMON.INTERACT'
2983 ! include 'COMMON.CONTACTS'
2984 ! include 'COMMON.TORSION'
2985 ! include 'COMMON.VECTORS'
2986 ! include 'COMMON.FFIELD'
2987 ! include 'COMMON.TIME1'
2988 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
2989 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2990 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2991 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2992 real(kind=8),dimension(4) :: muij
2993 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
2994 dist_temp, dist_init,rlocshield,fracinbuf
2995 integer xshift,yshift,zshift,ilist,iresshield
2996 !el integer :: num_conti,j1,j2
2997 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2998 !el dz_normi,xmedi,ymedi,zmedi
3000 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3001 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3004 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3006 real(kind=8) :: scal_el=1.0d0
3008 real(kind=8) :: scal_el=0.5d0
3011 ! 13-go grudnia roku pamietnego...
3012 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3014 0.0d0,0.0d0,1.0d0/),shape(unmat))
3015 ! integer :: maxconts=nres/4
3017 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
3018 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
3019 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
3020 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
3021 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
3022 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
3023 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
3024 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
3025 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
3026 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
3027 ecosgp,ecosam,ecosbm,ecosgm,ghalf
3029 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
3030 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
3032 ! time00=MPI_Wtime()
3033 !d write (iout,*) "eelecij",i,j
3037 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3038 aaa=app(iteli,itelj)
3039 bbb=bpp(iteli,itelj)
3040 ael6i=ael6(iteli,itelj)
3041 ael3i=ael3(iteli,itelj)
3045 dx_normj=dc_norm(1,j)
3046 dy_normj=dc_norm(2,j)
3047 dz_normj=dc_norm(3,j)
3048 ! xj=c(1,j)+0.5D0*dxj-xmedi
3049 ! yj=c(2,j)+0.5D0*dyj-ymedi
3050 ! zj=c(3,j)+0.5D0*dzj-zmedi
3055 if (xj.lt.0) xj=xj+boxxsize
3057 if (yj.lt.0) yj=yj+boxysize
3059 if (zj.lt.0) zj=zj+boxzsize
3060 if ((zj.gt.bordlipbot) &
3061 .and.(zj.lt.bordliptop)) then
3062 !C the energy transfer exist
3063 if (zj.lt.buflipbot) then
3064 !C what fraction I am in
3066 ((zj-bordlipbot)/lipbufthick)
3067 !C lipbufthick is thickenes of lipid buffore
3068 sslipj=sscalelip(fracinbuf)
3069 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3070 elseif (zj.gt.bufliptop) then
3071 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3072 sslipj=sscalelip(fracinbuf)
3073 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3084 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3091 xj=xj_safe+xshift*boxxsize
3092 yj=yj_safe+yshift*boxysize
3093 zj=zj_safe+zshift*boxzsize
3094 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3095 if(dist_temp.lt.dist_init) then
3105 if (isubchap.eq.1) then
3116 rij=xj*xj+yj*yj+zj*zj
3119 !C print *,xmedi,ymedi,zmedi,xj,yj,zj,boxxsize,rij
3120 sss_ele_cut=sscale_ele(rij)
3121 sss_ele_grad=sscagrad_ele(rij)
3123 ! sss_ele_grad=0.0d0
3124 ! print *,sss_ele_cut,sss_ele_grad,&
3125 ! (rij),r_cut_ele,rlamb_ele
3126 ! if (sss_ele_cut.le.0.0) go to 128
3131 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3132 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3133 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3134 fac=cosa-3.0D0*cosb*cosg
3136 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3137 if (j.eq.i+2) ev1=scal_el*ev1
3142 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3145 if (shield_mode.gt.0) then
3146 !C fac_shield(i)=0.4
3147 !C fac_shield(j)=0.6
3148 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3149 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3151 ees=ees+eesij*sss_ele_cut
3152 !C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
3153 !C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3159 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)*sss_ele_cut
3160 !C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
3163 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
3164 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3165 ! ees=ees+eesij*sss_ele_cut
3166 evdw1=evdw1+evdwij*sss_ele_cut &
3167 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3168 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3169 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3170 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3171 !d & xmedi,ymedi,zmedi,xj,yj,zj
3173 if (energy_dec) then
3174 ! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
3175 ! 'evdw1',i,j,evdwij,&
3176 ! iteli,itelj,aaa,evdw1
3177 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3178 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3181 ! Calculate contributions to the Cartesian gradient.
3184 facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut &
3185 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3186 facel=-3*rrmij*(el1+eesij)*sss_ele_cut &
3187 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3193 ! Radial derivatives. First process both termini of the fragment (i,j)
3195 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj* &
3196 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3197 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj* &
3198 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3199 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj* &
3200 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3202 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3203 (shield_mode.gt.0)) then
3205 do ilist=1,ishield_list(i)
3206 iresshield=shield_list(ilist,i)
3208 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)&
3210 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3212 +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 &
3214 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3217 do ilist=1,ishield_list(j)
3218 iresshield=shield_list(ilist,j)
3220 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) &
3222 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3224 +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 &
3226 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3230 gshieldc(k,i)=gshieldc(k,i)+ &
3231 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3234 gshieldc(k,j)=gshieldc(k,j)+ &
3235 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3238 gshieldc(k,i-1)=gshieldc(k,i-1)+ &
3239 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3242 gshieldc(k,j-1)=gshieldc(k,j-1)+ &
3243 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3251 ! ghalf=0.5D0*ggg(k)
3252 ! gelc(k,i)=gelc(k,i)+ghalf
3253 ! gelc(k,j)=gelc(k,j)+ghalf
3255 ! 9/28/08 AL Gradient compotents will be summed only at the end
3257 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3258 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3260 gelc_long(3,j)=gelc_long(3,j)+ &
3261 ssgradlipj*eesij/2.0d0*lipscale**2&
3264 gelc_long(3,i)=gelc_long(3,i)+ &
3265 ssgradlipi*eesij/2.0d0*lipscale**2&
3270 ! Loop over residues i+1 thru j-1.
3274 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3277 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
3278 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3279 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
3280 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3281 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
3282 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3285 ! ghalf=0.5D0*ggg(k)
3286 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3287 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3289 ! 9/28/08 AL Gradient compotents will be summed only at the end
3291 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3292 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3295 !C Lipidic part for scaling weight
3296 gvdwpp(3,j)=gvdwpp(3,j)+ &
3297 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3298 gvdwpp(3,i)=gvdwpp(3,i)+ &
3299 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3300 !! Loop over residues i+1 thru j-1.
3304 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3308 facvdw=(ev1+evdwij)*sss_ele_cut &
3309 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3311 facel=(el1+eesij)*sss_ele_cut
3313 fac=-3*rrmij*(facvdw+facvdw+facel)
3318 ! Radial derivatives. First process both termini of the fragment (i,j)
3320 ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj
3321 ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj
3322 ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj
3324 ! ghalf=0.5D0*ggg(k)
3325 ! gelc(k,i)=gelc(k,i)+ghalf
3326 ! gelc(k,j)=gelc(k,j)+ghalf
3328 ! 9/28/08 AL Gradient compotents will be summed only at the end
3330 gelc_long(k,j)=gelc(k,j)+ggg(k)
3331 gelc_long(k,i)=gelc(k,i)-ggg(k)
3334 ! Loop over residues i+1 thru j-1.
3338 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3341 ! 9/28/08 AL Gradient compotents will be summed only at the end
3343 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3345 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3347 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3350 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3351 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3353 gvdwpp(3,j)=gvdwpp(3,j)+ &
3354 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3355 gvdwpp(3,i)=gvdwpp(3,i)+ &
3356 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3362 ecosa=2.0D0*fac3*fac1+fac4
3365 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3366 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3368 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3369 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3371 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3372 !d & (dcosg(k),k=1,3)
3374 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut &
3375 *fac_shield(i)**2*fac_shield(j)**2 &
3376 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3380 ! ghalf=0.5D0*ggg(k)
3381 ! gelc(k,i)=gelc(k,i)+ghalf
3382 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3383 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3384 ! gelc(k,j)=gelc(k,j)+ghalf
3385 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3386 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3390 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3394 gelc(k,i)=gelc(k,i) &
3395 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3396 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
3398 *fac_shield(i)**2*fac_shield(j)**2 &
3399 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3401 gelc(k,j)=gelc(k,j) &
3402 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3403 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
3405 *fac_shield(i)**2*fac_shield(j)**2 &
3406 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3408 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3409 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3412 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3413 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
3414 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3416 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3417 ! energy of a peptide unit is assumed in the form of a second-order
3418 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3419 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3420 ! are computed for EVERY pair of non-contiguous peptide groups.
3422 if (j.lt.nres-1) then
3433 muij(kkk)=mu(k,i)*mu(l,j)
3436 !d write (iout,*) 'EELEC: i',i,' j',j
3437 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
3438 !d write(iout,*) 'muij',muij
3439 ury=scalar(uy(1,i),erij)
3440 urz=scalar(uz(1,i),erij)
3441 vry=scalar(uy(1,j),erij)
3442 vrz=scalar(uz(1,j),erij)
3443 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3444 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3445 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3446 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3447 fac=dsqrt(-ael6i)*r3ij
3452 !d write (iout,'(4i5,4f10.5)')
3453 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3454 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3455 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3456 !d & uy(:,j),uz(:,j)
3457 !d write (iout,'(4f10.5)')
3458 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3459 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3460 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
3461 !d write (iout,'(9f10.5/)')
3462 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3463 ! Derivatives of the elements of A in virtual-bond vectors
3464 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3466 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3467 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3468 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3469 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3470 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3471 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3472 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3473 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3474 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3475 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3476 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3477 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3479 ! Compute radial contributions to the gradient
3497 ! Add the contributions coming from er
3500 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3501 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3502 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3503 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3506 ! Derivatives in DC(i)
3507 !grad ghalf1=0.5d0*agg(k,1)
3508 !grad ghalf2=0.5d0*agg(k,2)
3509 !grad ghalf3=0.5d0*agg(k,3)
3510 !grad ghalf4=0.5d0*agg(k,4)
3511 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
3512 -3.0d0*uryg(k,2)*vry)!+ghalf1
3513 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
3514 -3.0d0*uryg(k,2)*vrz)!+ghalf2
3515 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
3516 -3.0d0*urzg(k,2)*vry)!+ghalf3
3517 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
3518 -3.0d0*urzg(k,2)*vrz)!+ghalf4
3519 ! Derivatives in DC(i+1)
3520 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
3521 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3522 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
3523 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3524 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
3525 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3526 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
3527 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3528 ! Derivatives in DC(j)
3529 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
3530 -3.0d0*vryg(k,2)*ury)!+ghalf1
3531 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
3532 -3.0d0*vrzg(k,2)*ury)!+ghalf2
3533 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
3534 -3.0d0*vryg(k,2)*urz)!+ghalf3
3535 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
3536 -3.0d0*vrzg(k,2)*urz)!+ghalf4
3537 ! Derivatives in DC(j+1) or DC(nres-1)
3538 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
3539 -3.0d0*vryg(k,3)*ury)
3540 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
3541 -3.0d0*vrzg(k,3)*ury)
3542 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
3543 -3.0d0*vryg(k,3)*urz)
3544 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
3545 -3.0d0*vrzg(k,3)*urz)
3546 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
3548 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3561 aggi(k,l)=-aggi(k,l)
3562 aggi1(k,l)=-aggi1(k,l)
3563 aggj(k,l)=-aggj(k,l)
3564 aggj1(k,l)=-aggj1(k,l)
3567 if (j.lt.nres-1) then
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)
3587 aggi(k,l)=-aggi(k,l)
3588 aggi1(k,l)=-aggi1(k,l)
3589 aggj(k,l)=-aggj(k,l)
3590 aggj1(k,l)=-aggj1(k,l)
3595 IF (wel_loc.gt.0.0d0) THEN
3596 ! Contribution to the local-electrostatic energy coming from the i-j pair
3597 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
3599 if (shield_mode.eq.0) then
3603 eel_loc_ij=eel_loc_ij &
3604 *fac_shield(i)*fac_shield(j) &
3605 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3606 !C Now derivative over eel_loc
3607 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3608 (shield_mode.gt.0)) then
3611 do ilist=1,ishield_list(i)
3612 iresshield=shield_list(ilist,i)
3614 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij &
3617 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3619 +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) &
3622 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3626 do ilist=1,ishield_list(j)
3627 iresshield=shield_list(ilist,j)
3629 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij &
3632 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3634 +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) &
3637 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3644 gshieldc_ll(k,i)=gshieldc_ll(k,i)+ &
3645 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3647 gshieldc_ll(k,j)=gshieldc_ll(k,j)+ &
3648 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3650 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ &
3651 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3653 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ &
3654 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3661 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3663 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3664 'eelloc',i,j,eel_loc_ij
3665 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
3666 ! if (energy_dec) write (iout,*) "muij",muij
3667 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3669 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
3670 ! Partial derivatives in virtual-bond dihedral angles gamma
3672 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
3673 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
3674 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
3676 *fac_shield(i)*fac_shield(j) &
3677 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3679 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
3680 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
3681 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
3683 *fac_shield(i)*fac_shield(j) &
3684 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3685 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3687 ! ggg(1)=(agg(1,1)*muij(1)+ &
3688 ! agg(1,2)*muij(2)+agg(1,3)*muij(3)+agg(1,4)*muij(4)) &
3690 ! +eel_loc_ij*sss_ele_grad*rmij*xj
3691 ! ggg(2)=(agg(2,1)*muij(1)+ &
3692 ! agg(2,2)*muij(2)+agg(2,3)*muij(3)+agg(2,4)*muij(4)) &
3694 ! +eel_loc_ij*sss_ele_grad*rmij*yj
3695 ! ggg(3)=(agg(3,1)*muij(1)+ &
3696 ! agg(3,2)*muij(2)+agg(3,3)*muij(3)+agg(3,4)*muij(4)) &
3698 ! +eel_loc_ij*sss_ele_grad*rmij*zj
3704 ggg(l)=(agg(l,1)*muij(1)+ &
3705 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
3707 *fac_shield(i)*fac_shield(j) &
3708 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) &
3709 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3712 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3713 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3714 !grad ghalf=0.5d0*ggg(l)
3715 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
3716 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
3718 gel_loc_long(3,j)=gel_loc_long(3,j)+ &
3719 ssgradlipj*eel_loc_ij/2.0d0*lipscale/ &
3720 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
3722 gel_loc_long(3,i)=gel_loc_long(3,i)+ &
3723 ssgradlipi*eel_loc_ij/2.0d0*lipscale/ &
3724 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
3728 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3731 ! Remaining derivatives of eello
3733 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
3734 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
3736 *fac_shield(i)*fac_shield(j) &
3737 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3739 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3740 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
3741 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) &
3742 +aggi1(l,4)*muij(4))&
3744 *fac_shield(i)*fac_shield(j) &
3745 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3747 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3748 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
3749 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
3751 *fac_shield(i)*fac_shield(j) &
3752 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3754 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3755 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
3756 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) &
3757 +aggj1(l,4)*muij(4))&
3759 *fac_shield(i)*fac_shield(j) &
3760 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3762 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3765 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
3766 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
3767 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
3768 .and. num_conti.le.maxconts) then
3769 ! write (iout,*) i,j," entered corr"
3771 ! Calculate the contact function. The ith column of the array JCONT will
3772 ! contain the numbers of atoms that make contacts with the atom I (of numbers
3773 ! greater than I). The arrays FACONT and GACONT will contain the values of
3774 ! the contact function and its derivative.
3775 ! r0ij=1.02D0*rpp(iteli,itelj)
3776 ! r0ij=1.11D0*rpp(iteli,itelj)
3777 r0ij=2.20D0*rpp(iteli,itelj)
3778 ! r0ij=1.55D0*rpp(iteli,itelj)
3779 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3780 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
3781 if (fcont.gt.0.0D0) then
3782 num_conti=num_conti+1
3783 if (num_conti.gt.maxconts) then
3784 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
3785 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
3786 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
3787 ' will skip next contacts for this conf.', num_conti
3789 jcont_hb(num_conti,i)=j
3790 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
3791 !d & " jcont_hb",jcont_hb(num_conti,i)
3792 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
3793 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3794 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3796 d_cont(num_conti,i)=rij
3797 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3798 ! --- Electrostatic-interaction matrix ---
3799 a_chuj(1,1,num_conti,i)=a22
3800 a_chuj(1,2,num_conti,i)=a23
3801 a_chuj(2,1,num_conti,i)=a32
3802 a_chuj(2,2,num_conti,i)=a33
3803 ! --- Gradient of rij
3805 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3812 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3813 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3814 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3815 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3816 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3821 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3822 ! Calculate contact energies
3824 wij=cosa-3.0D0*cosb*cosg
3827 ! fac3=dsqrt(-ael6i)/r0ij**3
3828 fac3=dsqrt(-ael6i)*r3ij
3829 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3830 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3831 if (ees0tmp.gt.0) then
3832 ees0pij=dsqrt(ees0tmp)
3836 if (shield_mode.eq.0) then
3840 ees0plist(num_conti,i)=j
3842 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3843 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3844 if (ees0tmp.gt.0) then
3845 ees0mij=dsqrt(ees0tmp)
3850 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
3852 *fac_shield(i)*fac_shield(j)
3854 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
3856 *fac_shield(i)*fac_shield(j)
3858 ! Diagnostics. Comment out or remove after debugging!
3859 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3860 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3861 ! ees0m(num_conti,i)=0.0D0
3863 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3864 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3865 ! Angular derivatives of the contact function
3866 ees0pij1=fac3/ees0pij
3867 ees0mij1=fac3/ees0mij
3868 fac3p=-3.0D0*fac3*rrmij
3869 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3870 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3872 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3873 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3874 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3875 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3876 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3877 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3878 ecosap=ecosa1+ecosa2
3879 ecosbp=ecosb1+ecosb2
3880 ecosgp=ecosg1+ecosg2
3881 ecosam=ecosa1-ecosa2
3882 ecosbm=ecosb1-ecosb2
3883 ecosgm=ecosg1-ecosg2
3892 facont_hb(num_conti,i)=fcont
3893 fprimcont=fprimcont/rij
3894 !d facont_hb(num_conti,i)=1.0D0
3895 ! Following line is for diagnostics.
3898 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3899 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3902 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3903 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3905 gggp(1)=gggp(1)+ees0pijp*xj &
3906 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
3907 gggp(2)=gggp(2)+ees0pijp*yj &
3908 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
3909 gggp(3)=gggp(3)+ees0pijp*zj &
3910 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
3912 gggm(1)=gggm(1)+ees0mijp*xj &
3913 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
3915 gggm(2)=gggm(2)+ees0mijp*yj &
3916 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
3918 gggm(3)=gggm(3)+ees0mijp*zj &
3919 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
3921 ! Derivatives due to the contact function
3922 gacont_hbr(1,num_conti,i)=fprimcont*xj
3923 gacont_hbr(2,num_conti,i)=fprimcont*yj
3924 gacont_hbr(3,num_conti,i)=fprimcont*zj
3927 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
3928 ! following the change of gradient-summation algorithm.
3930 !grad ghalfp=0.5D0*gggp(k)
3931 !grad ghalfm=0.5D0*gggm(k)
3932 gacontp_hb1(k,num_conti,i)= & !ghalfp+
3933 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3934 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
3935 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3937 gacontp_hb2(k,num_conti,i)= & !ghalfp+
3938 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3939 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
3940 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3942 gacontp_hb3(k,num_conti,i)=gggp(k) &
3943 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3945 gacontm_hb1(k,num_conti,i)= & !ghalfm+
3946 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3947 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
3948 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3950 gacontm_hb2(k,num_conti,i)= & !ghalfm+
3951 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3952 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
3953 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3955 gacontm_hb3(k,num_conti,i)=gggm(k) &
3956 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3959 ! Diagnostics. Comment out or remove after debugging!
3961 !diag gacontp_hb1(k,num_conti,i)=0.0D0
3962 !diag gacontp_hb2(k,num_conti,i)=0.0D0
3963 !diag gacontp_hb3(k,num_conti,i)=0.0D0
3964 !diag gacontm_hb1(k,num_conti,i)=0.0D0
3965 !diag gacontm_hb2(k,num_conti,i)=0.0D0
3966 !diag gacontm_hb3(k,num_conti,i)=0.0D0
3969 endif ! num_conti.le.maxconts
3972 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3975 ghalf=0.5d0*agg(l,k)
3976 aggi(l,k)=aggi(l,k)+ghalf
3977 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3978 aggj(l,k)=aggj(l,k)+ghalf
3981 if (j.eq.nres-1 .and. i.lt.j-2) then
3984 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3990 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
3992 end subroutine eelecij
3993 !-----------------------------------------------------------------------------
3994 subroutine eturn3(i,eello_turn3)
3995 ! Third- and fourth-order contributions from turns
3998 ! implicit real*8 (a-h,o-z)
3999 ! include 'DIMENSIONS'
4000 ! include 'COMMON.IOUNITS'
4001 ! include 'COMMON.GEO'
4002 ! include 'COMMON.VAR'
4003 ! include 'COMMON.LOCAL'
4004 ! include 'COMMON.CHAIN'
4005 ! include 'COMMON.DERIV'
4006 ! include 'COMMON.INTERACT'
4007 ! include 'COMMON.CONTACTS'
4008 ! include 'COMMON.TORSION'
4009 ! include 'COMMON.VECTORS'
4010 ! include 'COMMON.FFIELD'
4011 ! include 'COMMON.CONTROL'
4012 real(kind=8),dimension(3) :: ggg
4013 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4014 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4015 real(kind=8),dimension(2) :: auxvec,auxvec1
4016 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4017 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
4018 !el integer :: num_conti,j1,j2
4019 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4020 !el dz_normi,xmedi,ymedi,zmedi
4022 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4023 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4026 integer :: i,j,l,k,ilist,iresshield
4027 real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield
4030 ! write (iout,*) "eturn3",i,j,j1,j2
4031 zj=(c(3,j)+c(3,j+1))/2.0d0
4033 if (zj.lt.0) zj=zj+boxzsize
4034 if ((zj.lt.0)) write (*,*) "CHUJ"
4035 if ((zj.gt.bordlipbot) &
4036 .and.(zj.lt.bordliptop)) then
4037 !C the energy transfer exist
4038 if (zj.lt.buflipbot) then
4039 !C what fraction I am in
4041 ((zj-bordlipbot)/lipbufthick)
4042 !C lipbufthick is thickenes of lipid buffore
4043 sslipj=sscalelip(fracinbuf)
4044 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4045 elseif (zj.gt.bufliptop) then
4046 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4047 sslipj=sscalelip(fracinbuf)
4048 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4062 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4064 ! Third-order contributions
4071 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4072 !d call checkint_turn3(i,a_temp,eello_turn3_num)
4073 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4074 call transpose2(auxmat(1,1),auxmat1(1,1))
4075 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4076 if (shield_mode.eq.0) then
4081 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) &
4082 *fac_shield(i)*fac_shield(j) &
4083 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4085 0.5d0*(pizda(1,1)+pizda(2,2)) &
4086 *fac_shield(i)*fac_shield(j)
4088 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4089 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4090 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4091 (shield_mode.gt.0)) then
4094 do ilist=1,ishield_list(i)
4095 iresshield=shield_list(ilist,i)
4097 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4098 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4100 +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4101 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4105 do ilist=1,ishield_list(j)
4106 iresshield=shield_list(ilist,j)
4108 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4109 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4111 +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4112 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4119 gshieldc_t3(k,i)=gshieldc_t3(k,i)+ &
4120 grad_shield(k,i)*eello_t3/fac_shield(i)
4121 gshieldc_t3(k,j)=gshieldc_t3(k,j)+ &
4122 grad_shield(k,j)*eello_t3/fac_shield(j)
4123 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ &
4124 grad_shield(k,i)*eello_t3/fac_shield(i)
4125 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ &
4126 grad_shield(k,j)*eello_t3/fac_shield(j)
4130 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
4131 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
4132 !d & ' eello_turn3_num',4*eello_turn3_num
4133 ! Derivatives in gamma(i)
4134 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4135 call transpose2(auxmat2(1,1),auxmat3(1,1))
4136 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4137 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))&
4138 *fac_shield(i)*fac_shield(j) &
4139 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4140 ! Derivatives in gamma(i+1)
4141 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4142 call transpose2(auxmat2(1,1),auxmat3(1,1))
4143 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4144 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
4145 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4146 *fac_shield(i)*fac_shield(j) &
4147 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4149 ! Cartesian derivatives
4151 ! ghalf1=0.5d0*agg(l,1)
4152 ! ghalf2=0.5d0*agg(l,2)
4153 ! ghalf3=0.5d0*agg(l,3)
4154 ! ghalf4=0.5d0*agg(l,4)
4155 a_temp(1,1)=aggi(l,1)!+ghalf1
4156 a_temp(1,2)=aggi(l,2)!+ghalf2
4157 a_temp(2,1)=aggi(l,3)!+ghalf3
4158 a_temp(2,2)=aggi(l,4)!+ghalf4
4159 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4160 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
4161 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4162 *fac_shield(i)*fac_shield(j) &
4163 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4165 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4166 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4167 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4168 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4169 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4170 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
4171 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4172 *fac_shield(i)*fac_shield(j) &
4173 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4175 a_temp(1,1)=aggj(l,1)!+ghalf1
4176 a_temp(1,2)=aggj(l,2)!+ghalf2
4177 a_temp(2,1)=aggj(l,3)!+ghalf3
4178 a_temp(2,2)=aggj(l,4)!+ghalf4
4179 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4180 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
4181 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4182 *fac_shield(i)*fac_shield(j) &
4183 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4185 a_temp(1,1)=aggj1(l,1)
4186 a_temp(1,2)=aggj1(l,2)
4187 a_temp(2,1)=aggj1(l,3)
4188 a_temp(2,2)=aggj1(l,4)
4189 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4190 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
4191 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4192 *fac_shield(i)*fac_shield(j) &
4193 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4195 gshieldc_t3(3,i)=gshieldc_t3(3,i)+ &
4196 ssgradlipi*eello_t3/4.0d0*lipscale
4197 gshieldc_t3(3,j)=gshieldc_t3(3,j)+ &
4198 ssgradlipj*eello_t3/4.0d0*lipscale
4199 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+ &
4200 ssgradlipi*eello_t3/4.0d0*lipscale
4201 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+ &
4202 ssgradlipj*eello_t3/4.0d0*lipscale
4205 end subroutine eturn3
4206 !-----------------------------------------------------------------------------
4207 subroutine eturn4(i,eello_turn4)
4208 ! Third- and fourth-order contributions from turns
4211 ! implicit real*8 (a-h,o-z)
4212 ! include 'DIMENSIONS'
4213 ! include 'COMMON.IOUNITS'
4214 ! include 'COMMON.GEO'
4215 ! include 'COMMON.VAR'
4216 ! include 'COMMON.LOCAL'
4217 ! include 'COMMON.CHAIN'
4218 ! include 'COMMON.DERIV'
4219 ! include 'COMMON.INTERACT'
4220 ! include 'COMMON.CONTACTS'
4221 ! include 'COMMON.TORSION'
4222 ! include 'COMMON.VECTORS'
4223 ! include 'COMMON.FFIELD'
4224 ! include 'COMMON.CONTROL'
4225 real(kind=8),dimension(3) :: ggg
4226 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4227 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4228 real(kind=8),dimension(2) :: auxvec,auxvec1
4229 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4230 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
4231 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4232 !el dz_normi,xmedi,ymedi,zmedi
4233 !el integer :: num_conti,j1,j2
4234 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4235 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4238 integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
4239 real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
4243 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4245 ! Fourth-order contributions
4253 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4254 !d call checkint_turn4(i,a_temp,eello_turn4_num)
4255 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4256 zj=(c(3,j)+c(3,j+1))/2.0d0
4258 if (zj.lt.0) zj=zj+boxzsize
4259 if ((zj.gt.bordlipbot) &
4260 .and.(zj.lt.bordliptop)) then
4261 !C the energy transfer exist
4262 if (zj.lt.buflipbot) then
4263 !C what fraction I am in
4265 ((zj-bordlipbot)/lipbufthick)
4266 !C lipbufthick is thickenes of lipid buffore
4267 sslipj=sscalelip(fracinbuf)
4268 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4269 elseif (zj.gt.bufliptop) then
4270 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4271 sslipj=sscalelip(fracinbuf)
4272 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4286 iti1=itortyp(itype(i+1))
4287 iti2=itortyp(itype(i+2))
4288 iti3=itortyp(itype(i+3))
4289 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4290 call transpose2(EUg(1,1,i+1),e1t(1,1))
4291 call transpose2(Eug(1,1,i+2),e2t(1,1))
4292 call transpose2(Eug(1,1,i+3),e3t(1,1))
4293 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4294 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4295 s1=scalar2(b1(1,iti2),auxvec(1))
4296 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4297 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4298 s2=scalar2(b1(1,iti1),auxvec(1))
4299 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4300 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4301 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4302 if (shield_mode.eq.0) then
4307 eello_turn4=eello_turn4-(s1+s2+s3) &
4308 *fac_shield(i)*fac_shield(j) &
4309 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4310 eello_t4=-(s1+s2+s3) &
4311 *fac_shield(i)*fac_shield(j)
4312 !C Now derivative over shield:
4313 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4314 (shield_mode.gt.0)) then
4317 do ilist=1,ishield_list(i)
4318 iresshield=shield_list(ilist,i)
4320 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
4321 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4323 +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
4324 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4328 do ilist=1,ishield_list(j)
4329 iresshield=shield_list(ilist,j)
4331 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
4332 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4334 +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
4335 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4342 gshieldc_t4(k,i)=gshieldc_t4(k,i)+ &
4343 grad_shield(k,i)*eello_t4/fac_shield(i)
4344 gshieldc_t4(k,j)=gshieldc_t4(k,j)+ &
4345 grad_shield(k,j)*eello_t4/fac_shield(j)
4346 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ &
4347 grad_shield(k,i)*eello_t4/fac_shield(i)
4348 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ &
4349 grad_shield(k,j)*eello_t4/fac_shield(j)
4353 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4354 'eturn4',i,j,-(s1+s2+s3)
4355 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4356 !d & ' eello_turn4_num',8*eello_turn4_num
4357 ! Derivatives in gamma(i)
4358 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4359 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4360 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4361 s1=scalar2(b1(1,iti2),auxvec(1))
4362 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4363 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4364 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) &
4365 *fac_shield(i)*fac_shield(j) &
4366 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4368 ! Derivatives in gamma(i+1)
4369 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4370 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4371 s2=scalar2(b1(1,iti1),auxvec(1))
4372 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4373 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4374 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4375 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) &
4376 *fac_shield(i)*fac_shield(j) &
4377 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4379 ! Derivatives in gamma(i+2)
4380 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4381 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4382 s1=scalar2(b1(1,iti2),auxvec(1))
4383 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4384 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4385 s2=scalar2(b1(1,iti1),auxvec(1))
4386 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4387 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4388 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4389 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) &
4390 *fac_shield(i)*fac_shield(j) &
4391 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4393 ! Cartesian derivatives
4394 ! Derivatives of this turn contributions in DC(i+2)
4395 if (j.lt.nres-1) then
4397 a_temp(1,1)=agg(l,1)
4398 a_temp(1,2)=agg(l,2)
4399 a_temp(2,1)=agg(l,3)
4400 a_temp(2,2)=agg(l,4)
4401 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4402 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4403 s1=scalar2(b1(1,iti2),auxvec(1))
4404 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4405 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4406 s2=scalar2(b1(1,iti1),auxvec(1))
4407 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4408 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4409 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4411 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)&
4412 *fac_shield(i)*fac_shield(j) &
4413 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4417 ! Remaining derivatives of this turn contribution
4419 a_temp(1,1)=aggi(l,1)
4420 a_temp(1,2)=aggi(l,2)
4421 a_temp(2,1)=aggi(l,3)
4422 a_temp(2,2)=aggi(l,4)
4423 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4424 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4425 s1=scalar2(b1(1,iti2),auxvec(1))
4426 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4427 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4428 s2=scalar2(b1(1,iti1),auxvec(1))
4429 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4430 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4431 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4432 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) &
4433 *fac_shield(i)*fac_shield(j) &
4434 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4437 a_temp(1,1)=aggi1(l,1)
4438 a_temp(1,2)=aggi1(l,2)
4439 a_temp(2,1)=aggi1(l,3)
4440 a_temp(2,2)=aggi1(l,4)
4441 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4442 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4443 s1=scalar2(b1(1,iti2),auxvec(1))
4444 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4445 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4446 s2=scalar2(b1(1,iti1),auxvec(1))
4447 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4448 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4449 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4450 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) &
4451 *fac_shield(i)*fac_shield(j) &
4452 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4455 a_temp(1,1)=aggj(l,1)
4456 a_temp(1,2)=aggj(l,2)
4457 a_temp(2,1)=aggj(l,3)
4458 a_temp(2,2)=aggj(l,4)
4459 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4460 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4461 s1=scalar2(b1(1,iti2),auxvec(1))
4462 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4463 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4464 s2=scalar2(b1(1,iti1),auxvec(1))
4465 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4466 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4467 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4468 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) &
4469 *fac_shield(i)*fac_shield(j) &
4470 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4473 a_temp(1,1)=aggj1(l,1)
4474 a_temp(1,2)=aggj1(l,2)
4475 a_temp(2,1)=aggj1(l,3)
4476 a_temp(2,2)=aggj1(l,4)
4477 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4478 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4479 s1=scalar2(b1(1,iti2),auxvec(1))
4480 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4481 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4482 s2=scalar2(b1(1,iti1),auxvec(1))
4483 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4484 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4485 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4486 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4487 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) &
4488 *fac_shield(i)*fac_shield(j) &
4489 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4492 gshieldc_t4(3,i)=gshieldc_t4(3,i)+ &
4493 ssgradlipi*eello_t4/4.0d0*lipscale
4494 gshieldc_t4(3,j)=gshieldc_t4(3,j)+ &
4495 ssgradlipj*eello_t4/4.0d0*lipscale
4496 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+ &
4497 ssgradlipi*eello_t4/4.0d0*lipscale
4498 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+ &
4499 ssgradlipj*eello_t4/4.0d0*lipscale
4502 end subroutine eturn4
4503 !-----------------------------------------------------------------------------
4504 subroutine unormderiv(u,ugrad,unorm,ungrad)
4505 ! This subroutine computes the derivatives of a normalized vector u, given
4506 ! the derivatives computed without normalization conditions, ugrad. Returns
4509 real(kind=8),dimension(3) :: u,vec
4510 real(kind=8),dimension(3,3) ::ugrad,ungrad
4511 real(kind=8) :: unorm !,scalar
4513 ! write (2,*) 'ugrad',ugrad
4516 vec(i)=scalar(ugrad(1,i),u(1))
4518 ! write (2,*) 'vec',vec
4521 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4524 ! write (2,*) 'ungrad',ungrad
4526 end subroutine unormderiv
4527 !-----------------------------------------------------------------------------
4528 subroutine escp_soft_sphere(evdw2,evdw2_14)
4530 ! This subroutine calculates the excluded-volume interaction energy between
4531 ! peptide-group centers and side chains and its gradient in virtual-bond and
4532 ! side-chain vectors.
4534 ! implicit real*8 (a-h,o-z)
4535 ! include 'DIMENSIONS'
4536 ! include 'COMMON.GEO'
4537 ! include 'COMMON.VAR'
4538 ! include 'COMMON.LOCAL'
4539 ! include 'COMMON.CHAIN'
4540 ! include 'COMMON.DERIV'
4541 ! include 'COMMON.INTERACT'
4542 ! include 'COMMON.FFIELD'
4543 ! include 'COMMON.IOUNITS'
4544 ! include 'COMMON.CONTROL'
4545 real(kind=8),dimension(3) :: ggg
4547 integer :: i,iint,j,k,iteli,itypj
4548 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
4549 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
4554 !d print '(a)','Enter ESCP'
4555 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4556 do i=iatscp_s,iatscp_e
4557 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4559 xi=0.5D0*(c(1,i)+c(1,i+1))
4560 yi=0.5D0*(c(2,i)+c(2,i+1))
4561 zi=0.5D0*(c(3,i)+c(3,i+1))
4563 do iint=1,nscp_gr(i)
4565 do j=iscpstart(i,iint),iscpend(i,iint)
4566 if (itype(j).eq.ntyp1) cycle
4567 itypj=iabs(itype(j))
4568 ! Uncomment following three lines for SC-p interactions
4572 ! Uncomment following three lines for Ca-p interactions
4576 rij=xj*xj+yj*yj+zj*zj
4579 if (rij.lt.r0ijsq) then
4580 evdwij=0.25d0*(rij-r0ijsq)**2
4588 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
4593 !grad if (j.lt.i) then
4594 !d write (iout,*) 'j<i'
4595 ! Uncomment following three lines for SC-p interactions
4597 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4600 !d write (iout,*) 'j>i'
4602 !grad ggg(k)=-ggg(k)
4603 ! Uncomment following line for SC-p interactions
4604 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4608 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4610 !grad kstart=min0(i+1,j)
4611 !grad kend=max0(i-1,j-1)
4612 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4613 !d write (iout,*) ggg(1),ggg(2),ggg(3)
4614 !grad do k=kstart,kend
4616 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4620 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4621 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4628 end subroutine escp_soft_sphere
4629 !-----------------------------------------------------------------------------
4630 subroutine escp(evdw2,evdw2_14)
4632 ! This subroutine calculates the excluded-volume interaction energy between
4633 ! peptide-group centers and side chains and its gradient in virtual-bond and
4634 ! side-chain vectors.
4636 ! implicit real*8 (a-h,o-z)
4637 ! include 'DIMENSIONS'
4638 ! include 'COMMON.GEO'
4639 ! include 'COMMON.VAR'
4640 ! include 'COMMON.LOCAL'
4641 ! include 'COMMON.CHAIN'
4642 ! include 'COMMON.DERIV'
4643 ! include 'COMMON.INTERACT'
4644 ! include 'COMMON.FFIELD'
4645 ! include 'COMMON.IOUNITS'
4646 ! include 'COMMON.CONTROL'
4647 real(kind=8),dimension(3) :: ggg
4649 integer :: i,iint,j,k,iteli,itypj,subchap
4650 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
4652 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
4653 dist_temp, dist_init
4654 integer xshift,yshift,zshift
4658 !d print '(a)','Enter ESCP'
4659 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4660 do i=iatscp_s,iatscp_e
4661 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4663 xi=0.5D0*(c(1,i)+c(1,i+1))
4664 yi=0.5D0*(c(2,i)+c(2,i+1))
4665 zi=0.5D0*(c(3,i)+c(3,i+1))
4667 if (xi.lt.0) xi=xi+boxxsize
4669 if (yi.lt.0) yi=yi+boxysize
4671 if (zi.lt.0) zi=zi+boxzsize
4673 do iint=1,nscp_gr(i)
4675 do j=iscpstart(i,iint),iscpend(i,iint)
4676 itypj=iabs(itype(j))
4677 if (itypj.eq.ntyp1) cycle
4678 ! Uncomment following three lines for SC-p interactions
4682 ! Uncomment following three lines for Ca-p interactions
4690 if (xj.lt.0) xj=xj+boxxsize
4692 if (yj.lt.0) yj=yj+boxysize
4694 if (zj.lt.0) zj=zj+boxzsize
4695 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4703 xj=xj_safe+xshift*boxxsize
4704 yj=yj_safe+yshift*boxysize
4705 zj=zj_safe+zshift*boxzsize
4706 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4707 if(dist_temp.lt.dist_init) then
4717 if (subchap.eq.1) then
4727 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4728 rij=dsqrt(1.0d0/rrij)
4729 sss_ele_cut=sscale_ele(rij)
4730 sss_ele_grad=sscagrad_ele(rij)
4731 ! print *,sss_ele_cut,sss_ele_grad,&
4732 ! (rij),r_cut_ele,rlamb_ele
4733 if (sss_ele_cut.le.0.0) cycle
4735 e1=fac*fac*aad(itypj,iteli)
4736 e2=fac*bad(itypj,iteli)
4737 if (iabs(j-i) .le. 2) then
4740 evdw2_14=evdw2_14+(e1+e2)*sss_ele_cut
4743 evdw2=evdw2+evdwij*sss_ele_cut
4744 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
4745 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
4746 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4749 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
4751 fac=-(evdwij+e1)*rrij*sss_ele_cut
4752 fac=fac+evdwij*sss_ele_grad/rij/expon
4756 !grad if (j.lt.i) then
4757 !d write (iout,*) 'j<i'
4758 ! Uncomment following three lines for SC-p interactions
4760 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4763 !d write (iout,*) 'j>i'
4765 !grad ggg(k)=-ggg(k)
4766 ! Uncomment following line for SC-p interactions
4767 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4768 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4772 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4774 !grad kstart=min0(i+1,j)
4775 !grad kend=max0(i-1,j-1)
4776 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4777 !d write (iout,*) ggg(1),ggg(2),ggg(3)
4778 !grad do k=kstart,kend
4780 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4784 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4785 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4793 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4794 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4795 gradx_scp(j,i)=expon*gradx_scp(j,i)
4798 !******************************************************************************
4802 ! To save time the factor EXPON has been extracted from ALL components
4803 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
4806 !******************************************************************************
4809 !-----------------------------------------------------------------------------
4810 subroutine edis(ehpb)
4812 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4814 ! implicit real*8 (a-h,o-z)
4815 ! include 'DIMENSIONS'
4816 ! include 'COMMON.SBRIDGE'
4817 ! include 'COMMON.CHAIN'
4818 ! include 'COMMON.DERIV'
4819 ! include 'COMMON.VAR'
4820 ! include 'COMMON.INTERACT'
4821 ! include 'COMMON.IOUNITS'
4822 real(kind=8),dimension(3) :: ggg
4824 integer :: i,j,ii,jj,iii,jjj,k
4825 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
4828 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4829 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
4830 if (link_end.eq.0) return
4831 do i=link_start,link_end
4832 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4833 ! CA-CA distance used in regularization of structure.
4836 ! iii and jjj point to the residues for which the distance is assigned.
4837 if (ii.gt.nres) then
4844 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4845 ! & dhpb(i),dhpb1(i),forcon(i)
4846 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
4847 ! distance and angle dependent SS bond potential.
4848 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4849 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4850 if (.not.dyn_ss .and. i.le.nss) then
4851 ! 15/02/13 CC dynamic SSbond - additional check
4852 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. &
4853 iabs(itype(jjj)).eq.1) then
4854 call ssbond_ene(iii,jjj,eij)
4856 !d write (iout,*) "eij",eij
4859 ! Calculate the distance between the two points and its difference from the
4863 ! Get the force constant corresponding to this distance.
4865 ! Calculate the contribution to energy.
4866 ehpb=ehpb+waga*rdis*rdis
4868 ! Evaluate gradient.
4871 !d print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4872 !d & ' waga=',waga,' fac=',fac
4874 ggg(j)=fac*(c(j,jj)-c(j,ii))
4876 !d print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4877 ! If this is a SC-SC distance, we need to calculate the contributions to the
4878 ! Cartesian gradient in the SC vectors (ghpbx).
4881 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4882 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4885 !grad do j=iii,jjj-1
4887 !grad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4891 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4892 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4899 !-----------------------------------------------------------------------------
4900 subroutine ssbond_ene(i,j,eij)
4902 ! Calculate the distance and angle dependent SS-bond potential energy
4903 ! using a free-energy function derived based on RHF/6-31G** ab initio
4904 ! calculations of diethyl disulfide.
4906 ! A. Liwo and U. Kozlowska, 11/24/03
4908 ! implicit real*8 (a-h,o-z)
4909 ! include 'DIMENSIONS'
4910 ! include 'COMMON.SBRIDGE'
4911 ! include 'COMMON.CHAIN'
4912 ! include 'COMMON.DERIV'
4913 ! include 'COMMON.LOCAL'
4914 ! include 'COMMON.INTERACT'
4915 ! include 'COMMON.VAR'
4916 ! include 'COMMON.IOUNITS'
4917 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
4919 integer :: i,j,itypi,itypj,k
4920 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
4921 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
4922 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
4925 itypi=iabs(itype(i))
4929 dxi=dc_norm(1,nres+i)
4930 dyi=dc_norm(2,nres+i)
4931 dzi=dc_norm(3,nres+i)
4932 ! dsci_inv=dsc_inv(itypi)
4933 dsci_inv=vbld_inv(nres+i)
4934 itypj=iabs(itype(j))
4935 ! dscj_inv=dsc_inv(itypj)
4936 dscj_inv=vbld_inv(nres+j)
4940 dxj=dc_norm(1,nres+j)
4941 dyj=dc_norm(2,nres+j)
4942 dzj=dc_norm(3,nres+j)
4943 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4948 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4949 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4950 om12=dxi*dxj+dyi*dyj+dzi*dzj
4952 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4953 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4959 deltat12=om2-om1+2.0d0
4961 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
4962 +akct*deltad*deltat12 &
4963 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4964 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4965 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4966 ! & " deltat12",deltat12," eij",eij
4967 ed=2*akcm*deltad+akct*deltat12
4969 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4970 eom1=-2*akth*deltat1-pom1-om2*pom2
4971 eom2= 2*akth*deltat2+pom1-om1*pom2
4974 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4975 ghpbx(k,i)=ghpbx(k,i)-ggk &
4976 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
4977 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4978 ghpbx(k,j)=ghpbx(k,j)+ggk &
4979 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
4980 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4981 ghpbc(k,i)=ghpbc(k,i)-ggk
4982 ghpbc(k,j)=ghpbc(k,j)+ggk
4985 ! Calculate the components of the gradient in DC and X
4989 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4993 end subroutine ssbond_ene
4994 !-----------------------------------------------------------------------------
4995 subroutine ebond(estr)
4997 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4999 ! implicit real*8 (a-h,o-z)
5000 ! include 'DIMENSIONS'
5001 ! include 'COMMON.LOCAL'
5002 ! include 'COMMON.GEO'
5003 ! include 'COMMON.INTERACT'
5004 ! include 'COMMON.DERIV'
5005 ! include 'COMMON.VAR'
5006 ! include 'COMMON.CHAIN'
5007 ! include 'COMMON.IOUNITS'
5008 ! include 'COMMON.NAMES'
5009 ! include 'COMMON.FFIELD'
5010 ! include 'COMMON.CONTROL'
5011 ! include 'COMMON.SETUP'
5012 real(kind=8),dimension(3) :: u,ud
5014 integer :: i,j,iti,nbi,k
5015 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
5020 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
5021 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
5023 do i=ibondp_start,ibondp_end
5024 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5025 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5026 !C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5028 !C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
5029 !C *dc(j,i-1)/vbld(i)
5031 !C if (energy_dec) write(iout,*) &
5032 !C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5033 diff = vbld(i)-vbldpDUM
5035 diff = vbld(i)-vbldp0
5037 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
5038 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5041 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5043 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5046 estr=0.5d0*AKP*estr+estr1
5048 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5050 do i=ibond_start,ibond_end
5052 if (iti.ne.10 .and. iti.ne.ntyp1) then
5055 diff=vbld(i+nres)-vbldsc0(1,iti)
5056 if (energy_dec) write (iout,*) &
5057 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5058 AKSC(1,iti),AKSC(1,iti)*diff*diff
5059 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5061 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5065 diff=vbld(i+nres)-vbldsc0(j,iti)
5066 ud(j)=aksc(j,iti)*diff
5067 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5081 uprod2=uprod2*u(k)*u(k)
5085 usumsqder=usumsqder+ud(j)*uprod2
5087 estr=estr+uprod/usum
5089 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5095 end subroutine ebond
5097 !-----------------------------------------------------------------------------
5098 subroutine ebend(etheta)
5100 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5101 ! angles gamma and its derivatives in consecutive thetas and gammas.
5104 ! implicit real*8 (a-h,o-z)
5105 ! include 'DIMENSIONS'
5106 ! include 'COMMON.LOCAL'
5107 ! include 'COMMON.GEO'
5108 ! include 'COMMON.INTERACT'
5109 ! include 'COMMON.DERIV'
5110 ! include 'COMMON.VAR'
5111 ! include 'COMMON.CHAIN'
5112 ! include 'COMMON.IOUNITS'
5113 ! include 'COMMON.NAMES'
5114 ! include 'COMMON.FFIELD'
5115 ! include 'COMMON.CONTROL'
5116 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5117 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5118 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5120 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5121 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5122 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5124 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
5126 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
5127 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
5128 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
5129 real(kind=8),dimension(2) :: y,z
5132 ! time11=dexp(-2*time)
5135 ! write (*,'(a,i2)') 'EBEND ICG=',icg
5136 do i=ithet_start,ithet_end
5137 if (itype(i-1).eq.ntyp1) cycle
5138 ! Zero the energy function and its derivative at 0 or pi.
5139 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5141 ichir1=isign(1,itype(i-2))
5142 ichir2=isign(1,itype(i))
5143 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5144 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5145 if (itype(i-1).eq.10) then
5146 itype1=isign(10,itype(i-2))
5147 ichir11=isign(1,itype(i-2))
5148 ichir12=isign(1,itype(i-2))
5149 itype2=isign(10,itype(i))
5150 ichir21=isign(1,itype(i))
5151 ichir22=isign(1,itype(i))
5154 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
5157 if (phii.ne.phii) phii=150.0
5167 if (i.lt.nres .and. itype(i).ne.ntyp1) then
5170 if (phii1.ne.phii1) phii1=150.0
5182 ! Calculate the "mean" value of theta from the part of the distribution
5183 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5184 ! In following comments this theta will be referred to as t_c.
5185 thet_pred_mean=0.0d0
5187 athetk=athet(k,it,ichir1,ichir2)
5188 bthetk=bthet(k,it,ichir1,ichir2)
5190 athetk=athet(k,itype1,ichir11,ichir12)
5191 bthetk=bthet(k,itype2,ichir21,ichir22)
5193 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5195 dthett=thet_pred_mean*ssd
5196 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5197 ! Derivatives of the "mean" values in gamma1 and gamma2.
5198 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
5199 +athet(2,it,ichir1,ichir2)*y(1))*ss
5200 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
5201 +bthet(2,it,ichir1,ichir2)*z(1))*ss
5203 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
5204 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
5205 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
5206 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5208 if (theta(i).gt.pi-delta) then
5209 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
5211 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5212 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5213 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
5215 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
5217 else if (theta(i).lt.delta) then
5218 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5219 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5220 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
5222 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5223 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
5226 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
5229 etheta=etheta+ethetai
5230 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5232 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5233 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5234 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5236 ! Ufff.... We've done all this!!!
5238 end subroutine ebend
5239 !-----------------------------------------------------------------------------
5240 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
5243 ! implicit real*8 (a-h,o-z)
5244 ! include 'DIMENSIONS'
5245 ! include 'COMMON.LOCAL'
5246 ! include 'COMMON.IOUNITS'
5247 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5248 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5249 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5251 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
5253 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5254 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5255 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5257 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
5258 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5260 ! Calculate the contributions to both Gaussian lobes.
5261 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5262 ! The "polynomial part" of the "standard deviation" of this part of
5266 sig=sig*thet_pred_mean+polthet(j,it)
5268 ! Derivative of the "interior part" of the "standard deviation of the"
5269 ! gamma-dependent Gaussian lobe in t_c.
5270 sigtc=3*polthet(3,it)
5272 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5275 ! Set the parameters of both Gaussian lobes of the distribution.
5276 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5277 fac=sig*sig+sigc0(it)
5280 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5281 sigsqtc=-4.0D0*sigcsq*sigtc
5282 ! print *,i,sig,sigtc,sigsqtc
5283 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
5284 sigtc=-sigtc/(fac*fac)
5285 ! Following variable is sigma(t_c)**(-2)
5286 sigcsq=sigcsq*sigcsq
5288 sig0inv=1.0D0/sig0i**2
5289 delthec=thetai-thet_pred_mean
5290 delthe0=thetai-theta0i
5291 term1=-0.5D0*sigcsq*delthec*delthec
5292 term2=-0.5D0*sig0inv*delthe0*delthe0
5293 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5294 ! NaNs in taking the logarithm. We extract the largest exponent which is added
5295 ! to the energy (this being the log of the distribution) at the end of energy
5296 ! term evaluation for this virtual-bond angle.
5297 if (term1.gt.term2) then
5299 term2=dexp(term2-termm)
5303 term1=dexp(term1-termm)
5306 ! The ratio between the gamma-independent and gamma-dependent lobes of
5307 ! the distribution is a Gaussian function of thet_pred_mean too.
5308 diffak=gthet(2,it)-thet_pred_mean
5309 ratak=diffak/gthet(3,it)**2
5310 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5311 ! Let's differentiate it in thet_pred_mean NOW.
5313 ! Now put together the distribution terms to make complete distribution.
5314 termexp=term1+ak*term2
5315 termpre=sigc+ak*sig0i
5316 ! Contribution of the bending energy from this theta is just the -log of
5317 ! the sum of the contributions from the two lobes and the pre-exponential
5318 ! factor. Simple enough, isn't it?
5319 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5320 ! NOW the derivatives!!!
5321 ! 6/6/97 Take into account the deformation.
5322 E_theta=(delthec*sigcsq*term1 &
5323 +ak*delthe0*sig0inv*term2)/termexp
5324 E_tc=((sigtc+aktc*sig0i)/termpre &
5325 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
5326 aktc*term2)/termexp)
5328 end subroutine theteng
5330 !-----------------------------------------------------------------------------
5331 subroutine ebend(etheta)
5333 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5334 ! angles gamma and its derivatives in consecutive thetas and gammas.
5335 ! ab initio-derived potentials from
5336 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5338 ! implicit real*8 (a-h,o-z)
5339 ! include 'DIMENSIONS'
5340 ! include 'COMMON.LOCAL'
5341 ! include 'COMMON.GEO'
5342 ! include 'COMMON.INTERACT'
5343 ! include 'COMMON.DERIV'
5344 ! include 'COMMON.VAR'
5345 ! include 'COMMON.CHAIN'
5346 ! include 'COMMON.IOUNITS'
5347 ! include 'COMMON.NAMES'
5348 ! include 'COMMON.FFIELD'
5349 ! include 'COMMON.CONTROL'
5350 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
5351 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
5352 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
5353 logical :: lprn=.false., lprn1=.false.
5355 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
5356 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
5357 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl
5360 do i=ithet_start,ithet_end
5361 if (itype(i-1).eq.ntyp1) cycle
5362 if (itype(i-2).eq.ntyp1.or.itype(i).eq.ntyp1) cycle
5363 if (iabs(itype(i+1)).eq.20) iblock=2
5364 if (iabs(itype(i+1)).ne.20) iblock=1
5368 theti2=0.5d0*theta(i)
5369 ityp2=ithetyp((itype(i-1)))
5371 coskt(k)=dcos(k*theti2)
5372 sinkt(k)=dsin(k*theti2)
5374 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
5377 if (phii.ne.phii) phii=150.0
5381 ityp1=ithetyp((itype(i-2)))
5382 ! propagation of chirality for glycine type
5384 cosph1(k)=dcos(k*phii)
5385 sinph1(k)=dsin(k*phii)
5389 ityp1=ithetyp(itype(i-2))
5395 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5398 if (phii1.ne.phii1) phii1=150.0
5403 ityp3=ithetyp((itype(i)))
5405 cosph2(k)=dcos(k*phii1)
5406 sinph2(k)=dsin(k*phii1)
5410 ityp3=ithetyp(itype(i))
5416 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5419 ccl=cosph1(l)*cosph2(k-l)
5420 ssl=sinph1(l)*sinph2(k-l)
5421 scl=sinph1(l)*cosph2(k-l)
5422 csl=cosph1(l)*sinph2(k-l)
5423 cosph1ph2(l,k)=ccl-ssl
5424 cosph1ph2(k,l)=ccl+ssl
5425 sinph1ph2(l,k)=scl+csl
5426 sinph1ph2(k,l)=scl-csl
5430 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
5431 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5432 write (iout,*) "coskt and sinkt"
5434 write (iout,*) k,coskt(k),sinkt(k)
5438 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5439 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
5442 write (iout,*) "k",k,&
5443 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
5447 write (iout,*) "cosph and sinph"
5449 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5451 write (iout,*) "cosph1ph2 and sinph2ph2"
5454 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
5455 sinph1ph2(l,k),sinph1ph2(k,l)
5458 write(iout,*) "ethetai",ethetai
5462 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
5463 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
5464 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
5465 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5466 ethetai=ethetai+sinkt(m)*aux
5467 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5468 dephii=dephii+k*sinkt(m)* &
5469 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
5470 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5471 dephii1=dephii1+k*sinkt(m)* &
5472 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
5473 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5475 write (iout,*) "m",m," k",k," bbthet", &
5476 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
5477 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
5478 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
5479 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5483 write(iout,*) "ethetai",ethetai
5487 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5488 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
5489 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5490 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5491 ethetai=ethetai+sinkt(m)*aux
5492 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5493 dephii=dephii+l*sinkt(m)* &
5494 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
5495 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5496 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5497 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5498 dephii1=dephii1+(k-l)*sinkt(m)* &
5499 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5500 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5501 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
5502 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5504 write (iout,*) "m",m," k",k," l",l," ffthet",&
5505 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5506 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
5507 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5508 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
5510 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
5511 cosph1ph2(k,l)*sinkt(m),&
5512 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5520 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
5521 i,theta(i)*rad2deg,phii*rad2deg,&
5522 phii1*rad2deg,ethetai
5524 etheta=etheta+ethetai
5525 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5527 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5528 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5529 gloc(nphi+i-2,icg)=wang*dethetai
5532 end subroutine ebend
5535 !-----------------------------------------------------------------------------
5536 subroutine esc(escloc)
5537 ! Calculate the local energy of a side chain and its derivatives in the
5538 ! corresponding virtual-bond valence angles THETA and the spherical angles
5542 ! implicit real*8 (a-h,o-z)
5543 ! include 'DIMENSIONS'
5544 ! include 'COMMON.GEO'
5545 ! include 'COMMON.LOCAL'
5546 ! include 'COMMON.VAR'
5547 ! include 'COMMON.INTERACT'
5548 ! include 'COMMON.DERIV'
5549 ! include 'COMMON.CHAIN'
5550 ! include 'COMMON.IOUNITS'
5551 ! include 'COMMON.NAMES'
5552 ! include 'COMMON.FFIELD'
5553 ! include 'COMMON.CONTROL'
5554 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
5555 ddersc0,ddummy,xtemp,temp
5556 !el real(kind=8) :: time11,time12,time112,theti
5557 real(kind=8) :: escloc,delta
5558 !el integer :: it,nlobit
5559 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5562 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
5563 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5566 ! write (iout,'(a)') 'ESC'
5567 do i=loc_start,loc_end
5569 if (it.eq.ntyp1) cycle
5570 if (it.eq.10) goto 1
5571 nlobit=nlob(iabs(it))
5572 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
5573 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5574 theti=theta(i+1)-pipol
5579 if (x(2).gt.pi-delta) then
5583 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5585 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5586 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
5588 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5589 ddersc0(1),dersc(1))
5590 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
5591 ddersc0(3),dersc(3))
5593 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5595 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5596 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
5597 dersc0(2),esclocbi,dersc02)
5598 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5600 call splinthet(x(2),0.5d0*delta,ss,ssd)
5605 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5607 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5608 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5610 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5612 ! write (iout,*) escloci
5613 else if (x(2).lt.delta) then
5617 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5619 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5620 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
5622 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
5623 ddersc0(1),dersc(1))
5624 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
5625 ddersc0(3),dersc(3))
5627 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5629 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5630 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
5631 dersc0(2),esclocbi,dersc02)
5632 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
5637 call splinthet(x(2),0.5d0*delta,ss,ssd)
5639 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5641 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5642 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5644 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5645 ! write (iout,*) escloci
5647 call enesc(x,escloci,dersc,ddummy,.false.)
5650 escloc=escloc+escloci
5651 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5653 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5655 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
5657 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5658 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5663 !-----------------------------------------------------------------------------
5664 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5667 ! implicit real*8 (a-h,o-z)
5668 ! include 'DIMENSIONS'
5669 ! include 'COMMON.GEO'
5670 ! include 'COMMON.LOCAL'
5671 ! include 'COMMON.IOUNITS'
5672 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5673 real(kind=8),dimension(3) :: x,z,dersc,ddersc
5674 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
5675 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
5676 real(kind=8) :: escloci
5679 integer :: j,iii,l,k !el,it,nlobit
5680 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
5681 !el time11,time12,time112
5682 ! write (iout,*) 'it=',it,' nlobit=',nlobit
5686 if (mixed) ddersc(j)=0.0d0
5690 ! Because of periodicity of the dependence of the SC energy in omega we have
5691 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5692 ! To avoid underflows, first compute & store the exponents.
5700 z(k)=x(k)-censc(k,j,it)
5705 Axk=Axk+gaussc(l,k,j,it)*z(l)
5711 expfac=expfac+Ax(k,j,iii)*z(k)
5719 ! As in the case of ebend, we want to avoid underflows in exponentiation and
5720 ! subsequent NaNs and INFs in energy calculation.
5721 ! Find the largest exponent
5725 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5729 !d print *,'it=',it,' emin=',emin
5731 ! Compute the contribution to SC energy and derivatives
5736 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5737 if(adexp.ne.adexp) adexp=1.0
5740 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5742 !d print *,'j=',j,' expfac=',expfac
5743 escloc_i=escloc_i+expfac
5745 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5749 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
5750 +gaussc(k,2,j,it))*expfac
5757 dersc(1)=dersc(1)/cos(theti)**2
5758 ddersc(1)=ddersc(1)/cos(theti)**2
5761 escloci=-(dlog(escloc_i)-emin)
5763 dersc(j)=dersc(j)/escloc_i
5767 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5771 end subroutine enesc
5772 !-----------------------------------------------------------------------------
5773 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5776 ! implicit real*8 (a-h,o-z)
5777 ! include 'DIMENSIONS'
5778 ! include 'COMMON.GEO'
5779 ! include 'COMMON.LOCAL'
5780 ! include 'COMMON.IOUNITS'
5781 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5782 real(kind=8),dimension(3) :: x,z,dersc
5783 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
5784 real(kind=8),dimension(nlobit) :: contr !(maxlob)
5785 real(kind=8) :: escloci,dersc12,emin
5788 integer :: j,k,l !el,it,nlobit
5789 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
5799 z(k)=x(k)-censc(k,j,it)
5805 Axk=Axk+gaussc(l,k,j,it)*z(l)
5811 expfac=expfac+Ax(k,j)*z(k)
5816 ! As in the case of ebend, we want to avoid underflows in exponentiation and
5817 ! subsequent NaNs and INFs in energy calculation.
5818 ! Find the largest exponent
5821 if (emin.gt.contr(j)) emin=contr(j)
5825 ! Compute the contribution to SC energy and derivatives
5829 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5830 escloc_i=escloc_i+expfac
5832 dersc(k)=dersc(k)+Ax(k,j)*expfac
5834 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
5835 +gaussc(1,2,j,it))*expfac
5839 dersc(1)=dersc(1)/cos(theti)**2
5840 dersc12=dersc12/cos(theti)**2
5841 escloci=-(dlog(escloc_i)-emin)
5843 dersc(j)=dersc(j)/escloc_i
5845 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5847 end subroutine enesc_bound
5849 !-----------------------------------------------------------------------------
5850 subroutine esc(escloc)
5851 ! Calculate the local energy of a side chain and its derivatives in the
5852 ! corresponding virtual-bond valence angles THETA and the spherical angles
5853 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
5854 ! added by Urszula Kozlowska. 07/11/2007
5857 ! implicit real*8 (a-h,o-z)
5858 ! include 'DIMENSIONS'
5859 ! include 'COMMON.GEO'
5860 ! include 'COMMON.LOCAL'
5861 ! include 'COMMON.VAR'
5862 ! include 'COMMON.SCROT'
5863 ! include 'COMMON.INTERACT'
5864 ! include 'COMMON.DERIV'
5865 ! include 'COMMON.CHAIN'
5866 ! include 'COMMON.IOUNITS'
5867 ! include 'COMMON.NAMES'
5868 ! include 'COMMON.FFIELD'
5869 ! include 'COMMON.CONTROL'
5870 ! include 'COMMON.VECTORS'
5871 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
5872 real(kind=8),dimension(65) :: x
5873 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
5874 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
5875 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
5876 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
5877 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
5879 integer :: i,j,k !el,it,nlobit
5880 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
5881 !el real(kind=8) :: time11,time12,time112,theti
5882 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5883 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
5884 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
5885 sumene1x,sumene2x,sumene3x,sumene4x,&
5886 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
5889 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
5890 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
5893 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
5897 do i=loc_start,loc_end
5898 if (itype(i).eq.ntyp1) cycle
5899 costtab(i+1) =dcos(theta(i+1))
5900 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5901 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5902 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5903 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5904 cosfac=dsqrt(cosfac2)
5905 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5906 sinfac=dsqrt(sinfac2)
5908 if (it.eq.10) goto 1
5910 ! Compute the axes of tghe local cartesian coordinates system; store in
5911 ! x_prime, y_prime and z_prime
5918 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5919 ! & dc_norm(3,i+nres)
5921 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5922 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5925 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5928 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
5929 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
5930 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
5931 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5932 ! & " xy",scalar(x_prime(1),y_prime(1)),
5933 ! & " xz",scalar(x_prime(1),z_prime(1)),
5934 ! & " yy",scalar(y_prime(1),y_prime(1)),
5935 ! & " yz",scalar(y_prime(1),z_prime(1)),
5936 ! & " zz",scalar(z_prime(1),z_prime(1))
5938 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5939 ! to local coordinate system. Store in xx, yy, zz.
5945 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5946 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5947 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5954 ! Compute the energy of the ith side cbain
5956 ! write (2,*) "xx",xx," yy",yy," zz",zz
5959 x(j) = sc_parmin(j,it)
5962 !c diagnostics - remove later
5964 yy1 = dsin(alph(2))*dcos(omeg(2))
5965 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5966 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
5967 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
5969 !," --- ", xx_w,yy_w,zz_w
5972 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
5973 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
5975 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
5976 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
5978 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
5979 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
5980 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
5981 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
5982 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
5984 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
5985 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
5986 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
5987 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
5988 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
5990 dsc_i = 0.743d0+x(61)
5992 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5993 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5994 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
5995 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5996 s1=(1+x(63))/(0.1d0 + dscp1)
5997 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5998 s2=(1+x(65))/(0.1d0 + dscp2)
5999 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6000 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
6001 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6002 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6004 ! & dscp1,dscp2,sumene
6005 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6006 escloc = escloc + sumene
6007 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6012 ! This section to check the numerical derivatives of the energy of ith side
6013 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6014 ! #define DEBUG in the code to turn it on.
6016 write (2,*) "sumene =",sumene
6020 write (2,*) xx,yy,zz
6021 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6022 de_dxx_num=(sumenep-sumene)/aincr
6024 write (2,*) "xx+ sumene from enesc=",sumenep
6027 write (2,*) xx,yy,zz
6028 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6029 de_dyy_num=(sumenep-sumene)/aincr
6031 write (2,*) "yy+ sumene from enesc=",sumenep
6034 write (2,*) xx,yy,zz
6035 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6036 de_dzz_num=(sumenep-sumene)/aincr
6038 write (2,*) "zz+ sumene from enesc=",sumenep
6039 costsave=cost2tab(i+1)
6040 sintsave=sint2tab(i+1)
6041 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6042 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6043 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6044 de_dt_num=(sumenep-sumene)/aincr
6045 write (2,*) " t+ sumene from enesc=",sumenep
6046 cost2tab(i+1)=costsave
6047 sint2tab(i+1)=sintsave
6048 ! End of diagnostics section.
6051 ! Compute the gradient of esc
6053 ! zz=zz*dsign(1.0,dfloat(itype(i)))
6054 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6055 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6056 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6057 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6058 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6059 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6060 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6061 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6062 pom1=(sumene3*sint2tab(i+1)+sumene1) &
6063 *(pom_s1/dscp1+pom_s16*dscp1**4)
6064 pom2=(sumene4*cost2tab(i+1)+sumene2) &
6065 *(pom_s2/dscp2+pom_s26*dscp2**4)
6066 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6067 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
6068 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
6070 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6071 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
6072 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
6074 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
6075 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
6078 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6081 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6082 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
6083 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
6085 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6086 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
6087 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
6088 +x(59)*zz**2 +x(60)*xx*zz
6089 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
6090 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
6093 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6096 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
6097 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
6098 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
6099 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
6100 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
6101 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
6102 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
6103 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6105 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6108 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
6109 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
6110 +pom1*pom_dt1+pom2*pom_dt2
6112 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6116 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6117 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6118 cosfac2xx=cosfac2*xx
6119 sinfac2yy=sinfac2*yy
6121 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
6123 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
6125 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6126 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6127 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6128 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6129 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6130 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6131 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6132 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6133 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6134 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6138 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
6139 *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6140 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
6141 *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6144 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6145 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6146 dZZ_XYZ(k)=vbld_inv(i+nres)* &
6147 (z_prime(k)-zz*dC_norm(k,i+nres))
6149 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6150 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6154 dXX_Ctab(k,i)=dXX_Ci(k)
6155 dXX_C1tab(k,i)=dXX_Ci1(k)
6156 dYY_Ctab(k,i)=dYY_Ci(k)
6157 dYY_C1tab(k,i)=dYY_Ci1(k)
6158 dZZ_Ctab(k,i)=dZZ_Ci(k)
6159 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6160 dXX_XYZtab(k,i)=dXX_XYZ(k)
6161 dYY_XYZtab(k,i)=dYY_XYZ(k)
6162 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6166 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6167 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6168 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6169 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
6170 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6172 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6173 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6174 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
6175 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6176 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
6177 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6178 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
6179 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6181 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6182 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6184 ! to check gradient call subroutine check_grad
6190 !-----------------------------------------------------------------------------
6191 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
6193 real(kind=8),dimension(65) :: x
6194 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
6195 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6197 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6198 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6200 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6201 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6203 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6204 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6205 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6206 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6207 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6209 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6210 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6211 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6212 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6213 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6215 dsc_i = 0.743d0+x(61)
6217 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6218 *(xx*cost2+yy*sint2))
6219 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6220 *(xx*cost2-yy*sint2))
6221 s1=(1+x(63))/(0.1d0 + dscp1)
6222 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6223 s2=(1+x(65))/(0.1d0 + dscp2)
6224 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6225 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
6226 + (sumene4*cost2 +sumene2)*(s2+s2_6)
6231 !-----------------------------------------------------------------------------
6232 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6234 ! This procedure calculates two-body contact function g(rij) and its derivative:
6237 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6240 ! where x=(rij-r0ij)/delta
6242 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6245 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
6246 real(kind=8) :: x,x2,x4,delta
6250 if (x.lt.-1.0D0) then
6253 else if (x.le.1.0D0) then
6256 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6257 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6263 end subroutine gcont
6264 !-----------------------------------------------------------------------------
6265 subroutine splinthet(theti,delta,ss,ssder)
6266 ! implicit real*8 (a-h,o-z)
6267 ! include 'DIMENSIONS'
6268 ! include 'COMMON.VAR'
6269 ! include 'COMMON.GEO'
6270 real(kind=8) :: theti,delta,ss,ssder
6271 real(kind=8) :: thetup,thetlow
6274 if (theti.gt.pipol) then
6275 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6277 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6281 end subroutine splinthet
6282 !-----------------------------------------------------------------------------
6283 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6285 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
6286 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6287 a1=fprim0*delta/(f1-f0)
6293 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6294 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6296 end subroutine spline1
6297 !-----------------------------------------------------------------------------
6298 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6300 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
6301 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6306 a2=3*(f1x-f0x)-2*fprim0x*delta
6307 a3=fprim0x*delta-2*(f1x-f0x)
6308 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6310 end subroutine spline2
6311 !-----------------------------------------------------------------------------
6313 !-----------------------------------------------------------------------------
6314 subroutine etor(etors,edihcnstr)
6315 ! implicit real*8 (a-h,o-z)
6316 ! include 'DIMENSIONS'
6317 ! include 'COMMON.VAR'
6318 ! include 'COMMON.GEO'
6319 ! include 'COMMON.LOCAL'
6320 ! include 'COMMON.TORSION'
6321 ! include 'COMMON.INTERACT'
6322 ! include 'COMMON.DERIV'
6323 ! include 'COMMON.CHAIN'
6324 ! include 'COMMON.NAMES'
6325 ! include 'COMMON.IOUNITS'
6326 ! include 'COMMON.FFIELD'
6327 ! include 'COMMON.TORCNSTR'
6328 ! include 'COMMON.CONTROL'
6329 real(kind=8) :: etors,edihcnstr
6333 real(kind=8) :: phii,fac,etors_ii
6335 ! Set lprn=.true. for debugging
6339 do i=iphi_start,iphi_end
6341 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 &
6342 .or. itype(i).eq.ntyp1) cycle
6343 itori=itortyp(itype(i-2))
6344 itori1=itortyp(itype(i-1))
6347 ! Proline-Proline pair is a special case...
6348 if (itori.eq.3 .and. itori1.eq.3) then
6349 if (phii.gt.-dwapi3) then
6351 fac=1.0D0/(1.0D0-cosphi)
6352 etorsi=v1(1,3,3)*fac
6353 etorsi=etorsi+etorsi
6354 etors=etors+etorsi-v1(1,3,3)
6355 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6356 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6359 v1ij=v1(j+1,itori,itori1)
6360 v2ij=v2(j+1,itori,itori1)
6363 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6364 if (energy_dec) etors_ii=etors_ii+ &
6365 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6366 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6370 v1ij=v1(j,itori,itori1)
6371 v2ij=v2(j,itori,itori1)
6374 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6375 if (energy_dec) etors_ii=etors_ii+ &
6376 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6377 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6380 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6383 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6384 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
6385 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6386 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6387 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6389 ! 6/20/98 - dihedral angle constraints
6392 itori=idih_constr(i)
6395 if (difi.gt.drange(i)) then
6397 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6398 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6399 else if (difi.lt.-drange(i)) then
6401 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6402 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6404 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6405 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6407 ! write (iout,*) 'edihcnstr',edihcnstr
6410 !-----------------------------------------------------------------------------
6411 subroutine etor_d(etors_d)
6412 real(kind=8) :: etors_d
6415 end subroutine etor_d
6417 !-----------------------------------------------------------------------------
6418 subroutine etor(etors,edihcnstr)
6419 ! implicit real*8 (a-h,o-z)
6420 ! include 'DIMENSIONS'
6421 ! include 'COMMON.VAR'
6422 ! include 'COMMON.GEO'
6423 ! include 'COMMON.LOCAL'
6424 ! include 'COMMON.TORSION'
6425 ! include 'COMMON.INTERACT'
6426 ! include 'COMMON.DERIV'
6427 ! include 'COMMON.CHAIN'
6428 ! include 'COMMON.NAMES'
6429 ! include 'COMMON.IOUNITS'
6430 ! include 'COMMON.FFIELD'
6431 ! include 'COMMON.TORCNSTR'
6432 ! include 'COMMON.CONTROL'
6433 real(kind=8) :: etors,edihcnstr
6436 integer :: i,j,iblock,itori,itori1
6437 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
6438 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
6439 ! Set lprn=.true. for debugging
6443 do i=iphi_start,iphi_end
6444 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
6445 .or. itype(i-3).eq.ntyp1 &
6446 .or. itype(i).eq.ntyp1) cycle
6448 if (iabs(itype(i)).eq.20) then
6453 itori=itortyp(itype(i-2))
6454 itori1=itortyp(itype(i-1))
6457 ! Regular cosine and sine terms
6458 do j=1,nterm(itori,itori1,iblock)
6459 v1ij=v1(j,itori,itori1,iblock)
6460 v2ij=v2(j,itori,itori1,iblock)
6463 etors=etors+v1ij*cosphi+v2ij*sinphi
6464 if (energy_dec) etors_ii=etors_ii+ &
6465 v1ij*cosphi+v2ij*sinphi
6466 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6470 ! E = SUM ----------------------------------- - v1
6471 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6473 cosphi=dcos(0.5d0*phii)
6474 sinphi=dsin(0.5d0*phii)
6475 do j=1,nlor(itori,itori1,iblock)
6476 vl1ij=vlor1(j,itori,itori1)
6477 vl2ij=vlor2(j,itori,itori1)
6478 vl3ij=vlor3(j,itori,itori1)
6479 pom=vl2ij*cosphi+vl3ij*sinphi
6480 pom1=1.0d0/(pom*pom+1.0d0)
6481 etors=etors+vl1ij*pom1
6482 if (energy_dec) etors_ii=etors_ii+ &
6485 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6487 ! Subtract the constant term
6488 etors=etors-v0(itori,itori1,iblock)
6489 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6490 'etor',i,etors_ii-v0(itori,itori1,iblock)
6492 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6493 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,&
6494 (v1(j,itori,itori1,iblock),j=1,6),&
6495 (v2(j,itori,itori1,iblock),j=1,6)
6496 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6497 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6499 ! 6/20/98 - dihedral angle constraints
6501 ! do i=1,ndih_constr
6502 do i=idihconstr_start,idihconstr_end
6503 itori=idih_constr(i)
6505 difi=pinorm(phii-phi0(i))
6506 if (difi.gt.drange(i)) then
6508 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6509 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6510 else if (difi.lt.-drange(i)) then
6512 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6513 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6517 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6518 !d & rad2deg*phi0(i), rad2deg*drange(i),
6519 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6521 !d write (iout,*) 'edihcnstr',edihcnstr
6524 !-----------------------------------------------------------------------------
6525 subroutine etor_d(etors_d)
6526 ! 6/23/01 Compute double torsional energy
6527 ! implicit real*8 (a-h,o-z)
6528 ! include 'DIMENSIONS'
6529 ! include 'COMMON.VAR'
6530 ! include 'COMMON.GEO'
6531 ! include 'COMMON.LOCAL'
6532 ! include 'COMMON.TORSION'
6533 ! include 'COMMON.INTERACT'
6534 ! include 'COMMON.DERIV'
6535 ! include 'COMMON.CHAIN'
6536 ! include 'COMMON.NAMES'
6537 ! include 'COMMON.IOUNITS'
6538 ! include 'COMMON.FFIELD'
6539 ! include 'COMMON.TORCNSTR'
6540 real(kind=8) :: etors_d,etors_d_ii
6543 integer :: i,j,k,l,itori,itori1,itori2,iblock
6544 real(kind=8) :: phii,phii1,gloci1,gloci2,&
6545 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
6546 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
6547 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
6548 ! Set lprn=.true. for debugging
6552 ! write(iout,*) "a tu??"
6553 do i=iphid_start,iphid_end
6555 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 &
6556 .or. itype(i-3).eq.ntyp1 &
6557 .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
6558 itori=itortyp(itype(i-2))
6559 itori1=itortyp(itype(i-1))
6560 itori2=itortyp(itype(i))
6566 if (iabs(itype(i+1)).eq.20) iblock=2
6568 ! Regular cosine and sine terms
6569 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6570 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6571 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6572 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6573 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6574 cosphi1=dcos(j*phii)
6575 sinphi1=dsin(j*phii)
6576 cosphi2=dcos(j*phii1)
6577 sinphi2=dsin(j*phii1)
6578 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
6579 v2cij*cosphi2+v2sij*sinphi2
6580 if (energy_dec) etors_d_ii=etors_d_ii+ &
6581 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
6582 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6583 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6585 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6587 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6588 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6589 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6590 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6591 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6592 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6593 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6594 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6595 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6596 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6597 if (energy_dec) etors_d_ii=etors_d_ii+ &
6598 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6599 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6600 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
6601 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6602 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
6603 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6606 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6607 'etor_d',i,etors_d_ii
6608 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6609 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6612 end subroutine etor_d
6614 !-----------------------------------------------------------------------------
6615 subroutine eback_sc_corr(esccor)
6616 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
6617 ! conformational states; temporarily implemented as differences
6618 ! between UNRES torsional potentials (dependent on three types of
6619 ! residues) and the torsional potentials dependent on all 20 types
6620 ! of residues computed from AM1 energy surfaces of terminally-blocked
6621 ! amino-acid residues.
6622 ! implicit real*8 (a-h,o-z)
6623 ! include 'DIMENSIONS'
6624 ! include 'COMMON.VAR'
6625 ! include 'COMMON.GEO'
6626 ! include 'COMMON.LOCAL'
6627 ! include 'COMMON.TORSION'
6628 ! include 'COMMON.SCCOR'
6629 ! include 'COMMON.INTERACT'
6630 ! include 'COMMON.DERIV'
6631 ! include 'COMMON.CHAIN'
6632 ! include 'COMMON.NAMES'
6633 ! include 'COMMON.IOUNITS'
6634 ! include 'COMMON.FFIELD'
6635 ! include 'COMMON.CONTROL'
6636 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
6639 integer :: i,interty,j,isccori,isccori1,intertyp
6640 ! Set lprn=.true. for debugging
6643 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6645 do i=itau_start,itau_end
6646 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6648 isccori=isccortyp(itype(i-2))
6649 isccori1=isccortyp(itype(i-1))
6651 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6653 do intertyp=1,3 !intertyp
6655 !c Added 09 May 2012 (Adasko)
6656 !c Intertyp means interaction type of backbone mainchain correlation:
6657 ! 1 = SC...Ca...Ca...Ca
6658 ! 2 = Ca...Ca...Ca...SC
6659 ! 3 = SC...Ca...Ca...SCi
6661 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. &
6662 (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or. &
6663 (itype(i-1).eq.ntyp1))) &
6664 .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) &
6665 .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1) &
6666 .or.(itype(i).eq.ntyp1))) &
6667 .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. &
6668 (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. &
6669 (itype(i-3).eq.ntyp1)))) cycle
6670 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6671 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1)) &
6673 do j=1,nterm_sccor(isccori,isccori1)
6674 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6675 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6676 cosphi=dcos(j*tauangle(intertyp,i))
6677 sinphi=dsin(j*tauangle(intertyp,i))
6678 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
6679 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6680 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6682 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
6683 'esccor',i,intertyp,esccor_ii
6684 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6685 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6687 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6688 restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,&
6689 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
6690 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6691 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6696 end subroutine eback_sc_corr
6697 !-----------------------------------------------------------------------------
6698 subroutine multibody(ecorr)
6699 ! This subroutine calculates multi-body contributions to energy following
6700 ! the idea of Skolnick et al. If side chains I and J make a contact and
6701 ! at the same time side chains I+1 and J+1 make a contact, an extra
6702 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6703 ! implicit real*8 (a-h,o-z)
6704 ! include 'DIMENSIONS'
6705 ! include 'COMMON.IOUNITS'
6706 ! include 'COMMON.DERIV'
6707 ! include 'COMMON.INTERACT'
6708 ! include 'COMMON.CONTACTS'
6709 real(kind=8),dimension(3) :: gx,gx1
6711 real(kind=8) :: ecorr
6712 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
6713 ! Set lprn=.true. for debugging
6717 write (iout,'(a)') 'Contact function values:'
6719 write (iout,'(i2,20(1x,i2,f10.5))') &
6720 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6725 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6726 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6738 num_conti=num_cont(i)
6739 num_conti1=num_cont(i1)
6744 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6745 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6746 !d & ' ishift=',ishift
6747 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6748 ! The system gains extra energy.
6749 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6750 endif ! j1==j+-ishift
6758 end subroutine multibody
6759 !-----------------------------------------------------------------------------
6760 real(kind=8) function esccorr(i,j,k,l,jj,kk)
6761 ! implicit real*8 (a-h,o-z)
6762 ! include 'DIMENSIONS'
6763 ! include 'COMMON.IOUNITS'
6764 ! include 'COMMON.DERIV'
6765 ! include 'COMMON.INTERACT'
6766 ! include 'COMMON.CONTACTS'
6767 real(kind=8),dimension(3) :: gx,gx1
6769 integer :: i,j,k,l,jj,kk,m,ll
6770 real(kind=8) :: eij,ekl
6774 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6775 ! Calculate the multi-body contribution to energy.
6776 ! Calculate multi-body contributions to the gradient.
6777 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6778 !d & k,l,(gacont(m,kk,k),m=1,3)
6780 gx(m) =ekl*gacont(m,jj,i)
6781 gx1(m)=eij*gacont(m,kk,k)
6782 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6783 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6784 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6785 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6789 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6794 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6799 end function esccorr
6800 !-----------------------------------------------------------------------------
6801 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6802 ! This subroutine calculates multi-body contributions to hydrogen-bonding
6803 ! implicit real*8 (a-h,o-z)
6804 ! include 'DIMENSIONS'
6805 ! include 'COMMON.IOUNITS'
6808 ! integer :: maxconts !max_cont=maxconts =nres/4
6809 integer,parameter :: max_dim=26
6810 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6811 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6812 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
6813 !el common /przechowalnia/ zapas
6814 integer :: status(MPI_STATUS_SIZE)
6815 integer,dimension((nres/4)*2) :: req !maxconts*2
6816 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
6818 ! include 'COMMON.SETUP'
6819 ! include 'COMMON.FFIELD'
6820 ! include 'COMMON.DERIV'
6821 ! include 'COMMON.INTERACT'
6822 ! include 'COMMON.CONTACTS'
6823 ! include 'COMMON.CONTROL'
6824 ! include 'COMMON.LOCAL'
6825 real(kind=8),dimension(3) :: gx,gx1
6826 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
6827 logical :: lprn,ldone
6829 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
6830 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
6832 ! Set lprn=.true. for debugging
6836 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
6839 if (nfgtasks.le.1) goto 30
6841 write (iout,'(a)') 'Contact function values before RECEIVE:'
6843 write (iout,'(2i3,50(1x,i2,f5.2))') &
6844 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6849 do i=1,ntask_cont_from
6852 do i=1,ntask_cont_to
6855 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6857 ! Make the list of contacts to send to send to other procesors
6858 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6860 do i=iturn3_start,iturn3_end
6861 ! write (iout,*) "make contact list turn3",i," num_cont",
6863 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6865 do i=iturn4_start,iturn4_end
6866 ! write (iout,*) "make contact list turn4",i," num_cont",
6868 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6872 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
6874 do j=1,num_cont_hb(i)
6877 iproc=iint_sent_local(k,jjc,ii)
6878 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6879 if (iproc.gt.0) then
6880 ncont_sent(iproc)=ncont_sent(iproc)+1
6881 nn=ncont_sent(iproc)
6883 zapas(2,nn,iproc)=jjc
6884 zapas(3,nn,iproc)=facont_hb(j,i)
6885 zapas(4,nn,iproc)=ees0p(j,i)
6886 zapas(5,nn,iproc)=ees0m(j,i)
6887 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6888 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6889 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6890 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6891 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6892 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6893 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6894 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6895 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6896 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6897 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6898 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6899 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6900 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6901 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6902 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6903 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6904 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6905 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6906 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6907 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6914 "Numbers of contacts to be sent to other processors",&
6915 (ncont_sent(i),i=1,ntask_cont_to)
6916 write (iout,*) "Contacts sent"
6917 do ii=1,ntask_cont_to
6919 iproc=itask_cont_to(ii)
6920 write (iout,*) nn," contacts to processor",iproc,&
6921 " of CONT_TO_COMM group"
6923 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6931 CorrelID1=nfgtasks+fg_rank+1
6933 ! Receive the numbers of needed contacts from other processors
6934 do ii=1,ntask_cont_from
6935 iproc=itask_cont_from(ii)
6937 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
6938 FG_COMM,req(ireq),IERR)
6940 ! write (iout,*) "IRECV ended"
6942 ! Send the number of contacts needed by other processors
6943 do ii=1,ntask_cont_to
6944 iproc=itask_cont_to(ii)
6946 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
6947 FG_COMM,req(ireq),IERR)
6949 ! write (iout,*) "ISEND ended"
6950 ! write (iout,*) "number of requests (nn)",ireq
6953 call MPI_Waitall(ireq,req,status_array,ierr)
6955 ! & "Numbers of contacts to be received from other processors",
6956 ! & (ncont_recv(i),i=1,ntask_cont_from)
6960 do ii=1,ntask_cont_from
6961 iproc=itask_cont_from(ii)
6963 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
6964 ! & " of CONT_TO_COMM group"
6968 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
6969 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6970 ! write (iout,*) "ireq,req",ireq,req(ireq)
6973 ! Send the contacts to processors that need them
6974 do ii=1,ntask_cont_to
6975 iproc=itask_cont_to(ii)
6977 ! write (iout,*) nn," contacts to processor",iproc,
6978 ! & " of CONT_TO_COMM group"
6981 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
6982 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6983 ! write (iout,*) "ireq,req",ireq,req(ireq)
6985 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6989 ! write (iout,*) "number of requests (contacts)",ireq
6990 ! write (iout,*) "req",(req(i),i=1,4)
6993 call MPI_Waitall(ireq,req,status_array,ierr)
6994 do iii=1,ntask_cont_from
6995 iproc=itask_cont_from(iii)
6998 write (iout,*) "Received",nn," contacts from processor",iproc,&
6999 " of CONT_FROM_COMM group"
7002 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7007 ii=zapas_recv(1,i,iii)
7008 ! Flag the received contacts to prevent double-counting
7009 jj=-zapas_recv(2,i,iii)
7010 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7012 nnn=num_cont_hb(ii)+1
7015 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7016 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7017 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7018 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7019 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7020 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7021 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7022 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7023 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7024 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7025 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7026 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7027 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7028 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7029 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7030 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7031 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7032 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7033 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7034 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7035 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7036 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7037 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7038 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7043 write (iout,'(a)') 'Contact function values after receive:'
7045 write (iout,'(2i3,50(1x,i3,f5.2))') &
7046 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7054 write (iout,'(a)') 'Contact function values:'
7056 write (iout,'(2i3,50(1x,i3,f5.2))') &
7057 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7063 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7064 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7065 ! Remove the loop below after debugging !!!
7072 ! Calculate the local-electrostatic correlation terms
7073 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7075 num_conti=num_cont_hb(i)
7076 num_conti1=num_cont_hb(i+1)
7083 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
7084 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
7085 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7086 .or. j.lt.0 .and. j1.gt.0) .and. &
7087 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7088 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7089 ! The system gains extra energy.
7090 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7091 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
7092 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7094 else if (j1.eq.j) then
7095 ! Contacts I-J and I-(J+1) occur simultaneously.
7096 ! The system loses extra energy.
7097 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7102 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7103 ! & ' jj=',jj,' kk=',kk
7105 ! Contacts I-J and (I+1)-J occur simultaneously.
7106 ! The system loses extra energy.
7107 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7113 end subroutine multibody_hb
7114 !-----------------------------------------------------------------------------
7115 subroutine add_hb_contact(ii,jj,itask)
7116 ! implicit real*8 (a-h,o-z)
7117 ! include "DIMENSIONS"
7118 ! include "COMMON.IOUNITS"
7119 ! include "COMMON.CONTACTS"
7120 ! integer,parameter :: maxconts=nres/4
7121 integer,parameter :: max_dim=26
7122 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7123 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7124 ! common /przechowalnia/ zapas
7125 integer :: i,j,ii,jj,iproc,nn,jjc
7126 integer,dimension(4) :: itask
7127 ! write (iout,*) "itask",itask
7130 if (iproc.gt.0) then
7131 do j=1,num_cont_hb(ii)
7133 ! write (iout,*) "i",ii," j",jj," jjc",jjc
7135 ncont_sent(iproc)=ncont_sent(iproc)+1
7136 nn=ncont_sent(iproc)
7137 zapas(1,nn,iproc)=ii
7138 zapas(2,nn,iproc)=jjc
7139 zapas(3,nn,iproc)=facont_hb(j,ii)
7140 zapas(4,nn,iproc)=ees0p(j,ii)
7141 zapas(5,nn,iproc)=ees0m(j,ii)
7142 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7143 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7144 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7145 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7146 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7147 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7148 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7149 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7150 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7151 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7152 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7153 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7154 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7155 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7156 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7157 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7158 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7159 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7160 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7161 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7162 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7169 end subroutine add_hb_contact
7170 !-----------------------------------------------------------------------------
7171 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
7172 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7173 ! implicit real*8 (a-h,o-z)
7174 ! include 'DIMENSIONS'
7175 ! include 'COMMON.IOUNITS'
7176 integer,parameter :: max_dim=70
7179 ! integer :: maxconts !max_cont=maxconts=nres/4
7180 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7181 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7182 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7183 ! common /przechowalnia/ zapas
7184 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
7185 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
7188 ! include 'COMMON.SETUP'
7189 ! include 'COMMON.FFIELD'
7190 ! include 'COMMON.DERIV'
7191 ! include 'COMMON.LOCAL'
7192 ! include 'COMMON.INTERACT'
7193 ! include 'COMMON.CONTACTS'
7194 ! include 'COMMON.CHAIN'
7195 ! include 'COMMON.CONTROL'
7196 real(kind=8),dimension(3) :: gx,gx1
7197 integer,dimension(nres) :: num_cont_hb_old
7198 logical :: lprn,ldone
7199 !EL double precision eello4,eello5,eelo6,eello_turn6
7200 !EL external eello4,eello5,eello6,eello_turn6
7202 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
7203 j1,jp1,i1,num_conti1
7204 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
7205 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
7207 ! Set lprn=.true. for debugging
7212 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7214 num_cont_hb_old(i)=num_cont_hb(i)
7218 if (nfgtasks.le.1) goto 30
7220 write (iout,'(a)') 'Contact function values before RECEIVE:'
7222 write (iout,'(2i3,50(1x,i2,f5.2))') &
7223 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7228 do i=1,ntask_cont_from
7231 do i=1,ntask_cont_to
7234 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7236 ! Make the list of contacts to send to send to other procesors
7237 do i=iturn3_start,iturn3_end
7238 ! write (iout,*) "make contact list turn3",i," num_cont",
7240 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7242 do i=iturn4_start,iturn4_end
7243 ! write (iout,*) "make contact list turn4",i," num_cont",
7245 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7249 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7251 do j=1,num_cont_hb(i)
7254 iproc=iint_sent_local(k,jjc,ii)
7255 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7256 if (iproc.ne.0) then
7257 ncont_sent(iproc)=ncont_sent(iproc)+1
7258 nn=ncont_sent(iproc)
7260 zapas(2,nn,iproc)=jjc
7261 zapas(3,nn,iproc)=d_cont(j,i)
7265 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7270 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7278 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7289 "Numbers of contacts to be sent to other processors",&
7290 (ncont_sent(i),i=1,ntask_cont_to)
7291 write (iout,*) "Contacts sent"
7292 do ii=1,ntask_cont_to
7294 iproc=itask_cont_to(ii)
7295 write (iout,*) nn," contacts to processor",iproc,&
7296 " of CONT_TO_COMM group"
7298 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7306 CorrelID1=nfgtasks+fg_rank+1
7308 ! Receive the numbers of needed contacts from other processors
7309 do ii=1,ntask_cont_from
7310 iproc=itask_cont_from(ii)
7312 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7313 FG_COMM,req(ireq),IERR)
7315 ! write (iout,*) "IRECV ended"
7317 ! Send the number of contacts needed by other processors
7318 do ii=1,ntask_cont_to
7319 iproc=itask_cont_to(ii)
7321 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7322 FG_COMM,req(ireq),IERR)
7324 ! write (iout,*) "ISEND ended"
7325 ! write (iout,*) "number of requests (nn)",ireq
7328 call MPI_Waitall(ireq,req,status_array,ierr)
7330 ! & "Numbers of contacts to be received from other processors",
7331 ! & (ncont_recv(i),i=1,ntask_cont_from)
7335 do ii=1,ntask_cont_from
7336 iproc=itask_cont_from(ii)
7338 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7339 ! & " of CONT_TO_COMM group"
7343 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7344 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7345 ! write (iout,*) "ireq,req",ireq,req(ireq)
7348 ! Send the contacts to processors that need them
7349 do ii=1,ntask_cont_to
7350 iproc=itask_cont_to(ii)
7352 ! write (iout,*) nn," contacts to processor",iproc,
7353 ! & " of CONT_TO_COMM group"
7356 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7357 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7358 ! write (iout,*) "ireq,req",ireq,req(ireq)
7360 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7364 ! write (iout,*) "number of requests (contacts)",ireq
7365 ! write (iout,*) "req",(req(i),i=1,4)
7368 call MPI_Waitall(ireq,req,status_array,ierr)
7369 do iii=1,ntask_cont_from
7370 iproc=itask_cont_from(iii)
7373 write (iout,*) "Received",nn," contacts from processor",iproc,&
7374 " of CONT_FROM_COMM group"
7377 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7382 ii=zapas_recv(1,i,iii)
7383 ! Flag the received contacts to prevent double-counting
7384 jj=-zapas_recv(2,i,iii)
7385 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7387 nnn=num_cont_hb(ii)+1
7390 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7394 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7399 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7407 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7416 write (iout,'(a)') 'Contact function values after receive:'
7418 write (iout,'(2i3,50(1x,i3,5f6.3))') &
7419 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7420 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7427 write (iout,'(a)') 'Contact function values:'
7429 write (iout,'(2i3,50(1x,i2,5f6.3))') &
7430 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7431 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7438 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7439 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7440 ! Remove the loop below after debugging !!!
7447 ! Calculate the dipole-dipole interaction energies
7448 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7449 do i=iatel_s,iatel_e+1
7450 num_conti=num_cont_hb(i)
7459 ! Calculate the local-electrostatic correlation terms
7460 ! write (iout,*) "gradcorr5 in eello5 before loop"
7462 ! write (iout,'(i5,3f10.5)')
7463 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7465 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7466 ! write (iout,*) "corr loop i",i
7468 num_conti=num_cont_hb(i)
7469 num_conti1=num_cont_hb(i+1)
7476 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7477 ! & ' jj=',jj,' kk=',kk
7478 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
7479 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7480 .or. j.lt.0 .and. j1.gt.0) .and. &
7481 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7482 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7483 ! The system gains extra energy.
7485 sqd1=dsqrt(d_cont(jj,i))
7486 sqd2=dsqrt(d_cont(kk,i1))
7487 sred_geom = sqd1*sqd2
7488 IF (sred_geom.lt.cutoff_corr) THEN
7489 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
7491 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7492 !d & ' jj=',jj,' kk=',kk
7493 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7494 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7496 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7497 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7500 !d write (iout,*) 'sred_geom=',sred_geom,
7501 !d & ' ekont=',ekont,' fprim=',fprimcont,
7502 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7503 !d write (iout,*) "g_contij",g_contij
7504 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7505 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7506 call calc_eello(i,jp,i+1,jp1,jj,kk)
7507 if (wcorr4.gt.0.0d0) &
7508 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7509 if (energy_dec.and.wcorr4.gt.0.0d0) &
7510 write (iout,'(a6,4i5,0pf7.3)') &
7511 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7512 ! write (iout,*) "gradcorr5 before eello5"
7514 ! write (iout,'(i5,3f10.5)')
7515 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7517 if (wcorr5.gt.0.0d0) &
7518 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7519 ! write (iout,*) "gradcorr5 after eello5"
7521 ! write (iout,'(i5,3f10.5)')
7522 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7524 if (energy_dec.and.wcorr5.gt.0.0d0) &
7525 write (iout,'(a6,4i5,0pf7.3)') &
7526 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7527 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7528 !d write(2,*)'ijkl',i,jp,i+1,jp1
7529 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
7530 .or. wturn6.eq.0.0d0))then
7531 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7532 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7533 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7534 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7535 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7536 !d & 'ecorr6=',ecorr6
7537 !d write (iout,'(4e15.5)') sred_geom,
7538 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7539 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7540 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7541 else if (wturn6.gt.0.0d0 &
7542 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7543 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7544 eturn6=eturn6+eello_turn6(i,jj,kk)
7545 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7546 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7547 !d write (2,*) 'multibody_eello:eturn6',eturn6
7556 num_cont_hb(i)=num_cont_hb_old(i)
7558 ! write (iout,*) "gradcorr5 in eello5"
7560 ! write (iout,'(i5,3f10.5)')
7561 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7564 end subroutine multibody_eello
7565 !-----------------------------------------------------------------------------
7566 subroutine add_hb_contact_eello(ii,jj,itask)
7567 ! implicit real*8 (a-h,o-z)
7568 ! include "DIMENSIONS"
7569 ! include "COMMON.IOUNITS"
7570 ! include "COMMON.CONTACTS"
7571 ! integer,parameter :: maxconts=nres/4
7572 integer,parameter :: max_dim=70
7573 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7574 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7575 ! common /przechowalnia/ zapas
7577 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
7578 integer,dimension(4) ::itask
7579 ! write (iout,*) "itask",itask
7582 if (iproc.gt.0) then
7583 do j=1,num_cont_hb(ii)
7585 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7587 ncont_sent(iproc)=ncont_sent(iproc)+1
7588 nn=ncont_sent(iproc)
7589 zapas(1,nn,iproc)=ii
7590 zapas(2,nn,iproc)=jjc
7591 zapas(3,nn,iproc)=d_cont(j,ii)
7595 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7600 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7608 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7619 end subroutine add_hb_contact_eello
7620 !-----------------------------------------------------------------------------
7621 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7622 ! implicit real*8 (a-h,o-z)
7623 ! include 'DIMENSIONS'
7624 ! include 'COMMON.IOUNITS'
7625 ! include 'COMMON.DERIV'
7626 ! include 'COMMON.INTERACT'
7627 ! include 'COMMON.CONTACTS'
7628 real(kind=8),dimension(3) :: gx,gx1
7631 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
7632 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
7633 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
7634 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
7645 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7646 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7647 ! Following 4 lines for diagnostics.
7652 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7653 ! & 'Contacts ',i,j,
7654 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7655 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7657 ! Calculate the multi-body contribution to energy.
7658 ! ecorr=ecorr+ekont*ees
7659 ! Calculate multi-body contributions to the gradient.
7660 coeffpees0pij=coeffp*ees0pij
7661 coeffmees0mij=coeffm*ees0mij
7662 coeffpees0pkl=coeffp*ees0pkl
7663 coeffmees0mkl=coeffm*ees0mkl
7665 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7666 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
7667 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
7668 coeffmees0mkl*gacontm_hb1(ll,jj,i))
7669 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
7670 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
7671 coeffmees0mkl*gacontm_hb2(ll,jj,i))
7672 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7673 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
7674 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
7675 coeffmees0mij*gacontm_hb1(ll,kk,k))
7676 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
7677 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
7678 coeffmees0mij*gacontm_hb2(ll,kk,k))
7679 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
7680 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
7681 coeffmees0mkl*gacontm_hb3(ll,jj,i))
7682 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7683 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7684 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
7685 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
7686 coeffmees0mij*gacontm_hb3(ll,kk,k))
7687 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7688 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7689 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7694 !grad gradcorr(ll,m)=gradcorr(ll,m)+
7695 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
7696 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7697 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7702 !grad gradcorr(ll,m)=gradcorr(ll,m)+
7703 !grad & ees*eij*gacont_hbr(ll,kk,k)-
7704 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7705 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7708 ! write (iout,*) "ehbcorr",ekont*ees
7710 if (shield_mode.gt.0) then
7713 !C print *,i,j,fac_shield(i),fac_shield(j),
7714 !C &fac_shield(k),fac_shield(l)
7715 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
7716 (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
7717 do ilist=1,ishield_list(i)
7718 iresshield=shield_list(ilist,i)
7720 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
7721 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7723 +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
7724 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7728 do ilist=1,ishield_list(j)
7729 iresshield=shield_list(ilist,j)
7731 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
7732 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7734 +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
7735 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7740 do ilist=1,ishield_list(k)
7741 iresshield=shield_list(ilist,k)
7743 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
7744 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7746 +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
7747 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7751 do ilist=1,ishield_list(l)
7752 iresshield=shield_list(ilist,l)
7754 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
7755 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7757 +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
7758 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7763 gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
7764 grad_shield(m,i)*ehbcorr/fac_shield(i)
7765 gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
7766 grad_shield(m,j)*ehbcorr/fac_shield(j)
7767 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
7768 grad_shield(m,i)*ehbcorr/fac_shield(i)
7769 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
7770 grad_shield(m,j)*ehbcorr/fac_shield(j)
7772 gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
7773 grad_shield(m,k)*ehbcorr/fac_shield(k)
7774 gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
7775 grad_shield(m,l)*ehbcorr/fac_shield(l)
7776 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
7777 grad_shield(m,k)*ehbcorr/fac_shield(k)
7778 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
7779 grad_shield(m,l)*ehbcorr/fac_shield(l)
7785 end function ehbcorr
7787 !-----------------------------------------------------------------------------
7788 subroutine dipole(i,j,jj)
7789 ! implicit real*8 (a-h,o-z)
7790 ! include 'DIMENSIONS'
7791 ! include 'COMMON.IOUNITS'
7792 ! include 'COMMON.CHAIN'
7793 ! include 'COMMON.FFIELD'
7794 ! include 'COMMON.DERIV'
7795 ! include 'COMMON.INTERACT'
7796 ! include 'COMMON.CONTACTS'
7797 ! include 'COMMON.TORSION'
7798 ! include 'COMMON.VAR'
7799 ! include 'COMMON.GEO'
7800 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
7801 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
7802 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
7804 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
7805 allocate(dipderx(3,5,4,maxconts,nres))
7808 iti1 = itortyp(itype(i+1))
7809 if (j.lt.nres-1) then
7810 itj1 = itortyp(itype(j+1))
7815 dipi(iii,1)=Ub2(iii,i)
7816 dipderi(iii)=Ub2der(iii,i)
7817 dipi(iii,2)=b1(iii,iti1)
7818 dipj(iii,1)=Ub2(iii,j)
7819 dipderj(iii)=Ub2der(iii,j)
7820 dipj(iii,2)=b1(iii,itj1)
7824 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7827 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7834 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
7838 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7843 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7844 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7846 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7848 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7850 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7853 end subroutine dipole
7855 !-----------------------------------------------------------------------------
7856 subroutine calc_eello(i,j,k,l,jj,kk)
7858 ! This subroutine computes matrices and vectors needed to calculate
7859 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
7862 ! implicit real*8 (a-h,o-z)
7863 ! include 'DIMENSIONS'
7864 ! include 'COMMON.IOUNITS'
7865 ! include 'COMMON.CHAIN'
7866 ! include 'COMMON.DERIV'
7867 ! include 'COMMON.INTERACT'
7868 ! include 'COMMON.CONTACTS'
7869 ! include 'COMMON.TORSION'
7870 ! include 'COMMON.VAR'
7871 ! include 'COMMON.GEO'
7872 ! include 'COMMON.FFIELD'
7873 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
7874 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
7875 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
7878 !el common /kutas/ lprn
7879 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7880 !d & ' jj=',jj,' kk=',kk
7881 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7882 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7883 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7886 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7887 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7890 call transpose2(aa1(1,1),aa1t(1,1))
7891 call transpose2(aa2(1,1),aa2t(1,1))
7894 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
7895 aa1tder(1,1,lll,kkk))
7896 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
7897 aa2tder(1,1,lll,kkk))
7901 ! parallel orientation of the two CA-CA-CA frames.
7903 iti=itortyp(itype(i))
7907 itk1=itortyp(itype(k+1))
7908 itj=itortyp(itype(j))
7909 if (l.lt.nres-1) then
7910 itl1=itortyp(itype(l+1))
7914 ! A1 kernel(j+1) A2T
7916 !d write (iout,'(3f10.5,5x,3f10.5)')
7917 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7919 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7920 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
7921 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7922 ! Following matrices are needed only for 6-th order cumulants
7923 IF (wcorr6.gt.0.0d0) THEN
7924 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7925 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
7926 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7927 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7928 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
7929 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
7930 ADtEAderx(1,1,1,1,1,1))
7932 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
7933 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
7934 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
7935 ADtEA1derx(1,1,1,1,1,1))
7937 ! End 6-th order cumulants
7940 !d write (2,*) 'In calc_eello6'
7942 !d write (2,*) 'iii=',iii
7944 !d write (2,*) 'kkk=',kkk
7946 !d write (2,'(3(2f10.5),5x)')
7947 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7952 call transpose2(EUgder(1,1,k),auxmat(1,1))
7953 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7954 call transpose2(EUg(1,1,k),auxmat(1,1))
7955 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7956 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7960 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
7961 EAEAderx(1,1,lll,kkk,iii,1))
7965 ! A1T kernel(i+1) A2
7966 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7967 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
7968 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7969 ! Following matrices are needed only for 6-th order cumulants
7970 IF (wcorr6.gt.0.0d0) THEN
7971 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7972 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
7973 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7974 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7975 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
7976 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
7977 ADtEAderx(1,1,1,1,1,2))
7978 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
7979 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
7980 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
7981 ADtEA1derx(1,1,1,1,1,2))
7983 ! End 6-th order cumulants
7984 call transpose2(EUgder(1,1,l),auxmat(1,1))
7985 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7986 call transpose2(EUg(1,1,l),auxmat(1,1))
7987 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7988 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7992 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
7993 EAEAderx(1,1,lll,kkk,iii,2))
7998 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7999 ! They are needed only when the fifth- or the sixth-order cumulants are
8001 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8002 call transpose2(AEA(1,1,1),auxmat(1,1))
8003 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8004 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8005 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8006 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8007 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8008 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8009 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8010 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8011 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8012 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8013 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8014 call transpose2(AEA(1,1,2),auxmat(1,1))
8015 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
8016 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8017 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8018 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8019 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
8020 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8021 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
8022 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
8023 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8024 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8025 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8026 ! Calculate the Cartesian derivatives of the vectors.
8030 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8031 call matvec2(auxmat(1,1),b1(1,iti),&
8032 AEAb1derx(1,lll,kkk,iii,1,1))
8033 call matvec2(auxmat(1,1),Ub2(1,i),&
8034 AEAb2derx(1,lll,kkk,iii,1,1))
8035 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8036 AEAb1derx(1,lll,kkk,iii,2,1))
8037 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8038 AEAb2derx(1,lll,kkk,iii,2,1))
8039 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8040 call matvec2(auxmat(1,1),b1(1,itj),&
8041 AEAb1derx(1,lll,kkk,iii,1,2))
8042 call matvec2(auxmat(1,1),Ub2(1,j),&
8043 AEAb2derx(1,lll,kkk,iii,1,2))
8044 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8045 AEAb1derx(1,lll,kkk,iii,2,2))
8046 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
8047 AEAb2derx(1,lll,kkk,iii,2,2))
8054 ! Antiparallel orientation of the two CA-CA-CA frames.
8056 iti=itortyp(itype(i))
8060 itk1=itortyp(itype(k+1))
8061 itl=itortyp(itype(l))
8062 itj=itortyp(itype(j))
8063 if (j.lt.nres-1) then
8064 itj1=itortyp(itype(j+1))
8068 ! A2 kernel(j-1)T A1T
8069 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8070 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
8071 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8072 ! Following matrices are needed only for 6-th order cumulants
8073 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8074 j.eq.i+4 .and. l.eq.i+3)) THEN
8075 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8076 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
8077 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8078 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8079 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
8080 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8081 ADtEAderx(1,1,1,1,1,1))
8082 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8083 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
8084 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8085 ADtEA1derx(1,1,1,1,1,1))
8087 ! End 6-th order cumulants
8088 call transpose2(EUgder(1,1,k),auxmat(1,1))
8089 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8090 call transpose2(EUg(1,1,k),auxmat(1,1))
8091 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8092 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8096 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8097 EAEAderx(1,1,lll,kkk,iii,1))
8101 ! A2T kernel(i+1)T A1
8102 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8103 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
8104 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8105 ! Following matrices are needed only for 6-th order cumulants
8106 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8107 j.eq.i+4 .and. l.eq.i+3)) THEN
8108 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8109 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
8110 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8111 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8112 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
8113 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8114 ADtEAderx(1,1,1,1,1,2))
8115 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8116 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
8117 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8118 ADtEA1derx(1,1,1,1,1,2))
8120 ! End 6-th order cumulants
8121 call transpose2(EUgder(1,1,j),auxmat(1,1))
8122 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8123 call transpose2(EUg(1,1,j),auxmat(1,1))
8124 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8125 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8129 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8130 EAEAderx(1,1,lll,kkk,iii,2))
8135 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8136 ! They are needed only when the fifth- or the sixth-order cumulants are
8138 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
8139 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8140 call transpose2(AEA(1,1,1),auxmat(1,1))
8141 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8142 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8143 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8144 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8145 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8146 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8147 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8148 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8149 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8150 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8151 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8152 call transpose2(AEA(1,1,2),auxmat(1,1))
8153 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8154 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8155 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8156 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8157 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8158 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8159 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8160 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8161 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8162 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8163 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8164 ! Calculate the Cartesian derivatives of the vectors.
8168 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8169 call matvec2(auxmat(1,1),b1(1,iti),&
8170 AEAb1derx(1,lll,kkk,iii,1,1))
8171 call matvec2(auxmat(1,1),Ub2(1,i),&
8172 AEAb2derx(1,lll,kkk,iii,1,1))
8173 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8174 AEAb1derx(1,lll,kkk,iii,2,1))
8175 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8176 AEAb2derx(1,lll,kkk,iii,2,1))
8177 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8178 call matvec2(auxmat(1,1),b1(1,itl),&
8179 AEAb1derx(1,lll,kkk,iii,1,2))
8180 call matvec2(auxmat(1,1),Ub2(1,l),&
8181 AEAb2derx(1,lll,kkk,iii,1,2))
8182 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
8183 AEAb1derx(1,lll,kkk,iii,2,2))
8184 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
8185 AEAb2derx(1,lll,kkk,iii,2,2))
8193 end subroutine calc_eello
8194 !-----------------------------------------------------------------------------
8195 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
8200 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
8201 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
8202 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
8203 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
8204 integer :: iii,kkk,lll
8207 !el common /kutas/ lprn
8208 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8210 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
8213 !d if (lprn) write (2,*) 'In kernel'
8215 !d if (lprn) write (2,*) 'kkk=',kkk
8217 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
8218 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8220 !d write (2,*) 'lll=',lll
8221 !d write (2,*) 'iii=1'
8223 !d write (2,'(3(2f10.5),5x)')
8224 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8227 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
8228 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8230 !d write (2,*) 'lll=',lll
8231 !d write (2,*) 'iii=2'
8233 !d write (2,'(3(2f10.5),5x)')
8234 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8240 end subroutine kernel
8241 !-----------------------------------------------------------------------------
8242 real(kind=8) function eello4(i,j,k,l,jj,kk)
8243 ! implicit real*8 (a-h,o-z)
8244 ! include 'DIMENSIONS'
8245 ! include 'COMMON.IOUNITS'
8246 ! include 'COMMON.CHAIN'
8247 ! include 'COMMON.DERIV'
8248 ! include 'COMMON.INTERACT'
8249 ! include 'COMMON.CONTACTS'
8250 ! include 'COMMON.TORSION'
8251 ! include 'COMMON.VAR'
8252 ! include 'COMMON.GEO'
8253 real(kind=8),dimension(2,2) :: pizda
8254 real(kind=8),dimension(3) :: ggg1,ggg2
8255 real(kind=8) :: eel4,glongij,glongkl
8256 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
8257 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8261 !d print *,'eello4:',i,j,k,l,jj,kk
8262 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
8263 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
8264 !old eij=facont_hb(jj,i)
8265 !old ekl=facont_hb(kk,k)
8267 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8268 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8269 gcorr_loc(k-1)=gcorr_loc(k-1) &
8270 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8272 gcorr_loc(l-1)=gcorr_loc(l-1) &
8273 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8275 gcorr_loc(j-1)=gcorr_loc(j-1) &
8276 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8281 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
8282 -EAEAderx(2,2,lll,kkk,iii,1)
8283 !d derx(lll,kkk,iii)=0.0d0
8287 !d gcorr_loc(l-1)=0.0d0
8288 !d gcorr_loc(j-1)=0.0d0
8289 !d gcorr_loc(k-1)=0.0d0
8291 !d write (iout,*)'Contacts have occurred for peptide groups',
8292 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
8293 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8294 if (j.lt.nres-1) then
8301 if (l.lt.nres-1) then
8309 !grad ggg1(ll)=eel4*g_contij(ll,1)
8310 !grad ggg2(ll)=eel4*g_contij(ll,2)
8311 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8312 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8313 !grad ghalf=0.5d0*ggg1(ll)
8314 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8315 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8316 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8317 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8318 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8319 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8320 !grad ghalf=0.5d0*ggg2(ll)
8321 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8322 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8323 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8324 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8325 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8326 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8330 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8335 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8340 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8345 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8349 !d write (2,*) iii,gcorr_loc(iii)
8352 !d write (2,*) 'ekont',ekont
8353 !d write (iout,*) 'eello4',ekont*eel4
8356 !-----------------------------------------------------------------------------
8357 real(kind=8) function eello5(i,j,k,l,jj,kk)
8358 ! implicit real*8 (a-h,o-z)
8359 ! include 'DIMENSIONS'
8360 ! include 'COMMON.IOUNITS'
8361 ! include 'COMMON.CHAIN'
8362 ! include 'COMMON.DERIV'
8363 ! include 'COMMON.INTERACT'
8364 ! include 'COMMON.CONTACTS'
8365 ! include 'COMMON.TORSION'
8366 ! include 'COMMON.VAR'
8367 ! include 'COMMON.GEO'
8368 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8369 real(kind=8),dimension(2) :: vv
8370 real(kind=8),dimension(3) :: ggg1,ggg2
8371 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
8372 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
8373 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
8374 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8379 ! /l\ / \ \ / \ / \ / C
8380 ! / \ / \ \ / \ / \ / C
8381 ! j| o |l1 | o | o| o | | o |o C
8382 ! \ |/k\| |/ \| / |/ \| |/ \| C
8383 ! \i/ \ / \ / / \ / \ C
8385 ! (I) (II) (III) (IV) C
8387 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8389 ! Antiparallel chains C
8392 ! /j\ / \ \ / \ / \ / C
8393 ! / \ / \ \ / \ / \ / C
8394 ! j1| o |l | o | o| o | | o |o C
8395 ! \ |/k\| |/ \| / |/ \| |/ \| C
8396 ! \i/ \ / \ / / \ / \ C
8398 ! (I) (II) (III) (IV) C
8400 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8402 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
8404 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8405 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8410 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8412 itk=itortyp(itype(k))
8413 itl=itortyp(itype(l))
8414 itj=itortyp(itype(j))
8419 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8420 !d & eel5_3_num,eel5_4_num)
8424 derx(lll,kkk,iii)=0.0d0
8428 !d eij=facont_hb(jj,i)
8429 !d ekl=facont_hb(kk,k)
8431 !d write (iout,*)'Contacts have occurred for peptide groups',
8432 !d & i,j,' fcont:',eij,' eij',' and ',k,l
8434 ! Contribution from the graph I.
8435 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8436 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8437 call transpose2(EUg(1,1,k),auxmat(1,1))
8438 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8439 vv(1)=pizda(1,1)-pizda(2,2)
8440 vv(2)=pizda(1,2)+pizda(2,1)
8441 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
8442 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8443 ! Explicit gradient in virtual-dihedral angles.
8444 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
8445 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
8446 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8447 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8448 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8449 vv(1)=pizda(1,1)-pizda(2,2)
8450 vv(2)=pizda(1,2)+pizda(2,1)
8451 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8452 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
8453 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8454 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8455 vv(1)=pizda(1,1)-pizda(2,2)
8456 vv(2)=pizda(1,2)+pizda(2,1)
8458 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8459 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8460 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8462 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8463 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8464 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8466 ! Cartesian gradient
8470 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8472 vv(1)=pizda(1,1)-pizda(2,2)
8473 vv(2)=pizda(1,2)+pizda(2,1)
8474 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8475 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
8476 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8482 ! Contribution from graph II
8483 call transpose2(EE(1,1,itk),auxmat(1,1))
8484 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8485 vv(1)=pizda(1,1)+pizda(2,2)
8486 vv(2)=pizda(2,1)-pizda(1,2)
8487 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
8488 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8489 ! Explicit gradient in virtual-dihedral angles.
8490 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8491 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8492 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8493 vv(1)=pizda(1,1)+pizda(2,2)
8494 vv(2)=pizda(2,1)-pizda(1,2)
8496 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8497 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8498 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8500 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8501 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8502 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8504 ! Cartesian gradient
8508 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8510 vv(1)=pizda(1,1)+pizda(2,2)
8511 vv(2)=pizda(2,1)-pizda(1,2)
8512 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8513 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
8514 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8522 ! Parallel orientation
8523 ! Contribution from graph III
8524 call transpose2(EUg(1,1,l),auxmat(1,1))
8525 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8526 vv(1)=pizda(1,1)-pizda(2,2)
8527 vv(2)=pizda(1,2)+pizda(2,1)
8528 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
8529 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8530 ! Explicit gradient in virtual-dihedral angles.
8531 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8532 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
8533 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8534 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8535 vv(1)=pizda(1,1)-pizda(2,2)
8536 vv(2)=pizda(1,2)+pizda(2,1)
8537 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8538 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
8539 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8540 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8541 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8542 vv(1)=pizda(1,1)-pizda(2,2)
8543 vv(2)=pizda(1,2)+pizda(2,1)
8544 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8545 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
8546 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8547 ! Cartesian gradient
8551 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8553 vv(1)=pizda(1,1)-pizda(2,2)
8554 vv(2)=pizda(1,2)+pizda(2,1)
8555 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8556 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
8557 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8562 ! Contribution from graph IV
8564 call transpose2(EE(1,1,itl),auxmat(1,1))
8565 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8566 vv(1)=pizda(1,1)+pizda(2,2)
8567 vv(2)=pizda(2,1)-pizda(1,2)
8568 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
8569 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8570 ! Explicit gradient in virtual-dihedral angles.
8571 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8572 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8573 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8574 vv(1)=pizda(1,1)+pizda(2,2)
8575 vv(2)=pizda(2,1)-pizda(1,2)
8576 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8577 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
8578 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8579 ! Cartesian gradient
8583 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8585 vv(1)=pizda(1,1)+pizda(2,2)
8586 vv(2)=pizda(2,1)-pizda(1,2)
8587 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8588 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
8589 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8594 ! Antiparallel orientation
8595 ! Contribution from graph III
8597 call transpose2(EUg(1,1,j),auxmat(1,1))
8598 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8599 vv(1)=pizda(1,1)-pizda(2,2)
8600 vv(2)=pizda(1,2)+pizda(2,1)
8601 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
8602 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8603 ! Explicit gradient in virtual-dihedral angles.
8604 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8605 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
8606 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8607 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8608 vv(1)=pizda(1,1)-pizda(2,2)
8609 vv(2)=pizda(1,2)+pizda(2,1)
8610 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8611 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
8612 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8613 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8614 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8615 vv(1)=pizda(1,1)-pizda(2,2)
8616 vv(2)=pizda(1,2)+pizda(2,1)
8617 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8618 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
8619 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8620 ! Cartesian gradient
8624 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8626 vv(1)=pizda(1,1)-pizda(2,2)
8627 vv(2)=pizda(1,2)+pizda(2,1)
8628 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
8629 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
8630 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8635 ! Contribution from graph IV
8637 call transpose2(EE(1,1,itj),auxmat(1,1))
8638 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8639 vv(1)=pizda(1,1)+pizda(2,2)
8640 vv(2)=pizda(2,1)-pizda(1,2)
8641 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
8642 -0.5d0*scalar2(vv(1),Ctobr(1,j))
8643 ! Explicit gradient in virtual-dihedral angles.
8644 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8645 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8646 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8647 vv(1)=pizda(1,1)+pizda(2,2)
8648 vv(2)=pizda(2,1)-pizda(1,2)
8649 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8650 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
8651 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8652 ! Cartesian gradient
8656 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8658 vv(1)=pizda(1,1)+pizda(2,2)
8659 vv(2)=pizda(2,1)-pizda(1,2)
8660 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
8661 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
8662 -0.5d0*scalar2(vv(1),Ctobr(1,j))
8668 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8669 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8670 !d write (2,*) 'ijkl',i,j,k,l
8671 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8672 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
8674 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8675 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8676 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8677 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8678 if (j.lt.nres-1) then
8685 if (l.lt.nres-1) then
8695 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8696 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
8697 ! summed up outside the subrouine as for the other subroutines
8698 ! handling long-range interactions. The old code is commented out
8699 ! with "cgrad" to keep track of changes.
8701 !grad ggg1(ll)=eel5*g_contij(ll,1)
8702 !grad ggg2(ll)=eel5*g_contij(ll,2)
8703 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8704 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8705 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8706 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8707 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8708 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8709 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8710 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8712 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8713 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8714 !grad ghalf=0.5d0*ggg1(ll)
8716 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8717 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8718 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8719 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8720 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8721 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8722 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8723 !grad ghalf=0.5d0*ggg2(ll)
8725 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8726 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8727 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8728 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8729 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8730 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8735 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8736 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8741 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8742 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8748 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8753 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8757 !d write (2,*) iii,g_corr5_loc(iii)
8760 !d write (2,*) 'ekont',ekont
8761 !d write (iout,*) 'eello5',ekont*eel5
8764 !-----------------------------------------------------------------------------
8765 real(kind=8) function eello6(i,j,k,l,jj,kk)
8766 ! implicit real*8 (a-h,o-z)
8767 ! include 'DIMENSIONS'
8768 ! include 'COMMON.IOUNITS'
8769 ! include 'COMMON.CHAIN'
8770 ! include 'COMMON.DERIV'
8771 ! include 'COMMON.INTERACT'
8772 ! include 'COMMON.CONTACTS'
8773 ! include 'COMMON.TORSION'
8774 ! include 'COMMON.VAR'
8775 ! include 'COMMON.GEO'
8776 ! include 'COMMON.FFIELD'
8777 real(kind=8),dimension(3) :: ggg1,ggg2
8778 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
8780 real(kind=8) :: gradcorr6ij,gradcorr6kl
8781 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
8782 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8787 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8795 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8796 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8800 derx(lll,kkk,iii)=0.0d0
8804 !d eij=facont_hb(jj,i)
8805 !d ekl=facont_hb(kk,k)
8811 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8812 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8813 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8814 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8815 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8816 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8818 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8819 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8820 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8821 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8822 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8823 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8827 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8829 ! If turn contributions are considered, they will be handled separately.
8830 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8831 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8832 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8833 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8834 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8835 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8836 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8838 if (j.lt.nres-1) then
8845 if (l.lt.nres-1) then
8853 !grad ggg1(ll)=eel6*g_contij(ll,1)
8854 !grad ggg2(ll)=eel6*g_contij(ll,2)
8855 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8856 !grad ghalf=0.5d0*ggg1(ll)
8858 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8859 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8860 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8861 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8862 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8863 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8864 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8865 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8866 !grad ghalf=0.5d0*ggg2(ll)
8867 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8869 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8870 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8871 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8872 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8873 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8874 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8879 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8880 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8885 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8886 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8892 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8897 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8901 !d write (2,*) iii,g_corr6_loc(iii)
8904 !d write (2,*) 'ekont',ekont
8905 !d write (iout,*) 'eello6',ekont*eel6
8908 !-----------------------------------------------------------------------------
8909 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
8911 ! implicit real*8 (a-h,o-z)
8912 ! include 'DIMENSIONS'
8913 ! include 'COMMON.IOUNITS'
8914 ! include 'COMMON.CHAIN'
8915 ! include 'COMMON.DERIV'
8916 ! include 'COMMON.INTERACT'
8917 ! include 'COMMON.CONTACTS'
8918 ! include 'COMMON.TORSION'
8919 ! include 'COMMON.VAR'
8920 ! include 'COMMON.GEO'
8921 real(kind=8),dimension(2) :: vv,vv1
8922 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
8925 !el common /kutas/ lprn
8926 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
8927 real(kind=8) :: s1,s2,s3,s4,s5
8928 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8930 ! Parallel Antiparallel C
8936 ! \ j|/k\| / \ |/k\|l / C
8941 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8942 itk=itortyp(itype(k))
8943 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8944 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8945 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8946 call transpose2(EUgC(1,1,k),auxmat(1,1))
8947 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8948 vv1(1)=pizda1(1,1)-pizda1(2,2)
8949 vv1(2)=pizda1(1,2)+pizda1(2,1)
8950 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8951 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8952 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8953 s5=scalar2(vv(1),Dtobr2(1,i))
8954 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8955 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8956 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
8957 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
8958 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
8959 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
8960 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
8961 +scalar2(vv(1),Dtobr2der(1,i)))
8962 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8963 vv1(1)=pizda1(1,1)-pizda1(2,2)
8964 vv1(2)=pizda1(1,2)+pizda1(2,1)
8965 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8966 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8968 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
8969 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
8970 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
8971 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
8972 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8974 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
8975 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
8976 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
8977 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
8978 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8980 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8981 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8982 vv1(1)=pizda1(1,1)-pizda1(2,2)
8983 vv1(2)=pizda1(1,2)+pizda1(2,1)
8984 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
8985 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
8986 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
8987 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8996 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8997 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8998 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8999 call transpose2(EUgC(1,1,k),auxmat(1,1))
9000 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9002 vv1(1)=pizda1(1,1)-pizda1(2,2)
9003 vv1(2)=pizda1(1,2)+pizda1(2,1)
9004 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9005 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
9006 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
9007 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
9008 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
9009 s5=scalar2(vv(1),Dtobr2(1,i))
9010 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9015 end function eello6_graph1
9016 !-----------------------------------------------------------------------------
9017 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
9019 ! implicit real*8 (a-h,o-z)
9020 ! include 'DIMENSIONS'
9021 ! include 'COMMON.IOUNITS'
9022 ! include 'COMMON.CHAIN'
9023 ! include 'COMMON.DERIV'
9024 ! include 'COMMON.INTERACT'
9025 ! include 'COMMON.CONTACTS'
9026 ! include 'COMMON.TORSION'
9027 ! include 'COMMON.VAR'
9028 ! include 'COMMON.GEO'
9030 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
9031 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9033 !el common /kutas/ lprn
9034 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
9035 real(kind=8) :: s2,s3,s4
9036 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9038 ! Parallel Antiparallel C
9044 ! \ j|/k\| \ |/k\|l C
9049 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9050 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9051 ! AL 7/4/01 s1 would occur in the sixth-order moment,
9052 ! but not in a cluster cumulant
9054 s1=dip(1,jj,i)*dip(1,kk,k)
9056 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9057 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9058 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9059 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9060 call transpose2(EUg(1,1,k),auxmat(1,1))
9061 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9062 vv(1)=pizda(1,1)-pizda(2,2)
9063 vv(2)=pizda(1,2)+pizda(2,1)
9064 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9065 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9067 eello6_graph2=-(s1+s2+s3+s4)
9069 eello6_graph2=-(s2+s3+s4)
9072 ! Derivatives in gamma(i-1)
9075 s1=dipderg(1,jj,i)*dip(1,kk,k)
9077 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9078 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9079 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9080 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9082 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9084 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9086 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9088 ! Derivatives in gamma(k-1)
9090 s1=dip(1,jj,i)*dipderg(1,kk,k)
9092 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9093 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9094 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9095 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9096 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9097 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9098 vv(1)=pizda(1,1)-pizda(2,2)
9099 vv(2)=pizda(1,2)+pizda(2,1)
9100 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9102 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9104 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9106 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9107 ! Derivatives in gamma(j-1) or gamma(l-1)
9110 s1=dipderg(3,jj,i)*dip(1,kk,k)
9112 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9113 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9114 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9115 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9116 vv(1)=pizda(1,1)-pizda(2,2)
9117 vv(2)=pizda(1,2)+pizda(2,1)
9118 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9121 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9123 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9126 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9127 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9129 ! Derivatives in gamma(l-1) or gamma(j-1)
9132 s1=dip(1,jj,i)*dipderg(3,kk,k)
9134 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9135 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9136 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9137 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9138 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9139 vv(1)=pizda(1,1)-pizda(2,2)
9140 vv(2)=pizda(1,2)+pizda(2,1)
9141 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9144 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9146 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9149 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9150 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9152 ! Cartesian derivatives.
9154 write (2,*) 'In eello6_graph2'
9156 write (2,*) 'iii=',iii
9158 write (2,*) 'kkk=',kkk
9160 write (2,'(3(2f10.5),5x)') &
9161 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9171 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9173 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9176 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
9178 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9179 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
9181 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9182 call transpose2(EUg(1,1,k),auxmat(1,1))
9183 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
9185 vv(1)=pizda(1,1)-pizda(2,2)
9186 vv(2)=pizda(1,2)+pizda(2,1)
9187 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9188 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9190 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9192 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9195 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9197 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9203 end function eello6_graph2
9204 !-----------------------------------------------------------------------------
9205 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
9206 ! implicit real*8 (a-h,o-z)
9207 ! include 'DIMENSIONS'
9208 ! include 'COMMON.IOUNITS'
9209 ! include 'COMMON.CHAIN'
9210 ! include 'COMMON.DERIV'
9211 ! include 'COMMON.INTERACT'
9212 ! include 'COMMON.CONTACTS'
9213 ! include 'COMMON.TORSION'
9214 ! include 'COMMON.VAR'
9215 ! include 'COMMON.GEO'
9216 real(kind=8),dimension(2) :: vv,auxvec
9217 real(kind=8),dimension(2,2) :: pizda,auxmat
9219 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
9220 real(kind=8) :: s1,s2,s3,s4
9221 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9223 ! Parallel Antiparallel C
9229 ! j|/k\| / |/k\|l / C
9234 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9236 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9237 ! energy moment and not to the cluster cumulant.
9238 iti=itortyp(itype(i))
9239 if (j.lt.nres-1) then
9240 itj1=itortyp(itype(j+1))
9244 itk=itortyp(itype(k))
9245 itk1=itortyp(itype(k+1))
9246 if (l.lt.nres-1) then
9247 itl1=itortyp(itype(l+1))
9252 s1=dip(4,jj,i)*dip(4,kk,k)
9254 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9255 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9256 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9257 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9258 call transpose2(EE(1,1,itk),auxmat(1,1))
9259 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9260 vv(1)=pizda(1,1)+pizda(2,2)
9261 vv(2)=pizda(2,1)-pizda(1,2)
9262 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9263 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9264 !d & "sum",-(s2+s3+s4)
9266 eello6_graph3=-(s1+s2+s3+s4)
9268 eello6_graph3=-(s2+s3+s4)
9271 ! Derivatives in gamma(k-1)
9272 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9273 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9274 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9275 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9276 ! Derivatives in gamma(l-1)
9277 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9278 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9279 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9280 vv(1)=pizda(1,1)+pizda(2,2)
9281 vv(2)=pizda(2,1)-pizda(1,2)
9282 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9283 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9284 ! Cartesian derivatives.
9290 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9292 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9295 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9297 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9298 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
9300 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9301 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
9303 vv(1)=pizda(1,1)+pizda(2,2)
9304 vv(2)=pizda(2,1)-pizda(1,2)
9305 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9307 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9309 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9312 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9314 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9316 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9321 end function eello6_graph3
9322 !-----------------------------------------------------------------------------
9323 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9324 ! implicit real*8 (a-h,o-z)
9325 ! include 'DIMENSIONS'
9326 ! include 'COMMON.IOUNITS'
9327 ! include 'COMMON.CHAIN'
9328 ! include 'COMMON.DERIV'
9329 ! include 'COMMON.INTERACT'
9330 ! include 'COMMON.CONTACTS'
9331 ! include 'COMMON.TORSION'
9332 ! include 'COMMON.VAR'
9333 ! include 'COMMON.GEO'
9334 ! include 'COMMON.FFIELD'
9335 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
9336 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9338 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
9340 real(kind=8) :: s1,s2,s3,s4
9341 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9343 ! Parallel Antiparallel C
9349 ! \ j|/k\| \ |/k\|l C
9354 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9356 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9357 ! energy moment and not to the cluster cumulant.
9358 !d write (2,*) 'eello_graph4: wturn6',wturn6
9359 iti=itortyp(itype(i))
9360 itj=itortyp(itype(j))
9361 if (j.lt.nres-1) then
9362 itj1=itortyp(itype(j+1))
9366 itk=itortyp(itype(k))
9367 if (k.lt.nres-1) then
9368 itk1=itortyp(itype(k+1))
9372 itl=itortyp(itype(l))
9373 if (l.lt.nres-1) then
9374 itl1=itortyp(itype(l+1))
9378 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9379 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9380 !d & ' itl',itl,' itl1',itl1
9383 s1=dip(3,jj,i)*dip(3,kk,k)
9385 s1=dip(2,jj,j)*dip(2,kk,l)
9388 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9389 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9391 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9392 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9394 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9395 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9397 call transpose2(EUg(1,1,k),auxmat(1,1))
9398 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9399 vv(1)=pizda(1,1)-pizda(2,2)
9400 vv(2)=pizda(2,1)+pizda(1,2)
9401 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9402 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9404 eello6_graph4=-(s1+s2+s3+s4)
9406 eello6_graph4=-(s2+s3+s4)
9408 ! Derivatives in gamma(i-1)
9412 s1=dipderg(2,jj,i)*dip(3,kk,k)
9414 s1=dipderg(4,jj,j)*dip(2,kk,l)
9417 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9419 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9420 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9422 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9423 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9425 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9426 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9427 !d write (2,*) 'turn6 derivatives'
9429 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9431 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9435 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9437 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9441 ! Derivatives in gamma(k-1)
9444 s1=dip(3,jj,i)*dipderg(2,kk,k)
9446 s1=dip(2,jj,j)*dipderg(4,kk,l)
9449 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9450 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9452 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9453 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9455 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9456 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9458 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9459 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9460 vv(1)=pizda(1,1)-pizda(2,2)
9461 vv(2)=pizda(2,1)+pizda(1,2)
9462 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9463 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9465 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9467 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9471 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9473 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9476 ! Derivatives in gamma(j-1) or gamma(l-1)
9477 if (l.eq.j+1 .and. l.gt.1) then
9478 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9479 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9480 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9481 vv(1)=pizda(1,1)-pizda(2,2)
9482 vv(2)=pizda(2,1)+pizda(1,2)
9483 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9484 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9485 else if (j.gt.1) then
9486 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9487 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9488 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9489 vv(1)=pizda(1,1)-pizda(2,2)
9490 vv(2)=pizda(2,1)+pizda(1,2)
9491 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9492 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9493 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9495 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9498 ! Cartesian derivatives.
9505 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9507 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9511 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9513 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9517 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
9519 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9521 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9522 b1(1,itj1),auxvec(1))
9523 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9525 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9526 b1(1,itl1),auxvec(1))
9527 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9529 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9531 vv(1)=pizda(1,1)-pizda(2,2)
9532 vv(2)=pizda(2,1)+pizda(1,2)
9533 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9535 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9537 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9540 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9543 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9546 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9548 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9550 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9554 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9556 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9559 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9561 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9568 end function eello6_graph4
9569 !-----------------------------------------------------------------------------
9570 real(kind=8) function eello_turn6(i,jj,kk)
9571 ! implicit real*8 (a-h,o-z)
9572 ! include 'DIMENSIONS'
9573 ! include 'COMMON.IOUNITS'
9574 ! include 'COMMON.CHAIN'
9575 ! include 'COMMON.DERIV'
9576 ! include 'COMMON.INTERACT'
9577 ! include 'COMMON.CONTACTS'
9578 ! include 'COMMON.TORSION'
9579 ! include 'COMMON.VAR'
9580 ! include 'COMMON.GEO'
9581 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
9582 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
9583 real(kind=8),dimension(3) :: ggg1,ggg2
9584 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
9585 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
9586 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9587 ! the respective energy moment and not to the cluster cumulant.
9589 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
9590 integer :: j1,j2,l1,l2,ll
9591 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
9592 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
9601 iti=itortyp(itype(i))
9602 itk=itortyp(itype(k))
9603 itk1=itortyp(itype(k+1))
9604 itl=itortyp(itype(l))
9605 itj=itortyp(itype(j))
9606 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9607 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
9608 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9613 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9615 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
9619 derx_turn(lll,kkk,iii)=0.0d0
9626 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9628 !d write (2,*) 'eello6_5',eello6_5
9630 call transpose2(AEA(1,1,1),auxmat(1,1))
9631 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9632 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9633 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9635 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9636 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9637 s2 = scalar2(b1(1,itk),vtemp1(1))
9639 call transpose2(AEA(1,1,2),atemp(1,1))
9640 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9641 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9642 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9644 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9645 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9646 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9648 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9649 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9650 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9651 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9652 ss13 = scalar2(b1(1,itk),vtemp4(1))
9653 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9655 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9661 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9662 ! Derivatives in gamma(i+2)
9666 call transpose2(AEA(1,1,1),auxmatd(1,1))
9667 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9668 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9669 call transpose2(AEAderg(1,1,2),atempd(1,1))
9670 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9671 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9673 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9674 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9675 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9681 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9682 ! Derivatives in gamma(i+3)
9684 call transpose2(AEA(1,1,1),auxmatd(1,1))
9685 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9686 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9687 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9689 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9690 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9691 s2d = scalar2(b1(1,itk),vtemp1d(1))
9693 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9694 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9696 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9698 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9699 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9700 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9708 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
9709 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9711 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
9712 -0.5d0*ekont*(s2d+s12d)
9714 ! Derivatives in gamma(i+4)
9715 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9716 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9717 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9719 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9720 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9721 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9729 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9731 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9733 ! Derivatives in gamma(i+5)
9735 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9736 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9737 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9739 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9740 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9741 s2d = scalar2(b1(1,itk),vtemp1d(1))
9743 call transpose2(AEA(1,1,2),atempd(1,1))
9744 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9745 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9747 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9748 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9750 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9751 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9752 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9760 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
9761 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9763 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
9764 -0.5d0*ekont*(s2d+s12d)
9766 ! Cartesian derivatives
9771 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9772 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9773 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9775 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9776 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
9778 s2d = scalar2(b1(1,itk),vtemp1d(1))
9780 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9781 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9782 s8d = -(atempd(1,1)+atempd(2,2))* &
9783 scalar2(cc(1,1,itl),vtemp2(1))
9785 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
9787 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9788 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9795 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
9798 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
9802 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
9805 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
9814 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
9816 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9817 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9818 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9819 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9820 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
9822 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9823 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9824 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9828 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9829 !d & 16*eel_turn6_num
9831 if (j.lt.nres-1) then
9838 if (l.lt.nres-1) then
9846 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
9847 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
9848 !grad ghalf=0.5d0*ggg1(ll)
9850 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9851 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9852 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
9853 +ekont*derx_turn(ll,2,1)
9854 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9855 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
9856 +ekont*derx_turn(ll,4,1)
9857 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9858 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9859 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9860 !grad ghalf=0.5d0*ggg2(ll)
9862 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
9863 +ekont*derx_turn(ll,2,2)
9864 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9865 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
9866 +ekont*derx_turn(ll,4,2)
9867 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9868 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9869 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9874 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9879 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9885 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9890 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9894 !d write (2,*) iii,g_corr6_loc(iii)
9896 eello_turn6=ekont*eel_turn6
9897 !d write (2,*) 'ekont',ekont
9898 !d write (2,*) 'eel_turn6',ekont*eel_turn6
9900 end function eello_turn6
9901 !-----------------------------------------------------------------------------
9902 subroutine MATVEC2(A1,V1,V2)
9903 !DIR$ INLINEALWAYS MATVEC2
9905 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9907 ! implicit real*8 (a-h,o-z)
9908 ! include 'DIMENSIONS'
9909 real(kind=8),dimension(2) :: V1,V2
9910 real(kind=8),dimension(2,2) :: A1
9911 real(kind=8) :: vaux1,vaux2
9915 ! 3 VI=VI+A1(I,K)*V1(K)
9919 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9920 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9924 end subroutine MATVEC2
9925 !-----------------------------------------------------------------------------
9926 subroutine MATMAT2(A1,A2,A3)
9928 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9930 ! implicit real*8 (a-h,o-z)
9931 ! include 'DIMENSIONS'
9932 real(kind=8),dimension(2,2) :: A1,A2,A3
9933 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
9934 ! DIMENSION AI3(2,2)
9938 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
9944 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9945 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9946 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9947 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9953 end subroutine MATMAT2
9954 !-----------------------------------------------------------------------------
9955 real(kind=8) function scalar2(u,v)
9956 !DIR$ INLINEALWAYS scalar2
9958 real(kind=8),dimension(2) :: u,v
9961 scalar2=u(1)*v(1)+u(2)*v(2)
9963 end function scalar2
9964 !-----------------------------------------------------------------------------
9965 subroutine transpose2(a,at)
9966 !DIR$ INLINEALWAYS transpose2
9968 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
9971 real(kind=8),dimension(2,2) :: a,at
9977 end subroutine transpose2
9978 !-----------------------------------------------------------------------------
9979 subroutine transpose(n,a,at)
9982 real(kind=8),dimension(n,n) :: a,at
9989 end subroutine transpose
9990 !-----------------------------------------------------------------------------
9991 subroutine prodmat3(a1,a2,kk,transp,prod)
9992 !DIR$ INLINEALWAYS prodmat3
9994 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
9998 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
10000 !rc double precision auxmat(2,2),prod_(2,2)
10003 !rc call transpose2(kk(1,1),auxmat(1,1))
10004 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10005 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10007 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
10008 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10009 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
10010 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10011 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
10012 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10013 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
10014 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10017 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10018 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10020 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
10021 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10022 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
10023 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10024 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
10025 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10026 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
10027 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10030 ! call transpose2(a2(1,1),a2t(1,1))
10033 !rc print *,((prod_(i,j),i=1,2),j=1,2)
10034 !rc print *,((prod(i,j),i=1,2),j=1,2)
10037 end subroutine prodmat3
10038 !-----------------------------------------------------------------------------
10039 ! energy_p_new_barrier.F
10040 !-----------------------------------------------------------------------------
10041 subroutine sum_gradient
10042 ! implicit real*8 (a-h,o-z)
10043 use io_base, only: pdbout
10044 ! include 'DIMENSIONS'
10048 !MS$ATTRIBUTES C :: proc_proc
10054 real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
10055 gloc_scbuf !(3,maxres)
10057 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
10059 !el local variables
10060 integer :: i,j,k,ierror,ierr
10061 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
10062 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
10063 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
10064 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
10065 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
10066 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
10067 gsccorr_max,gsccorrx_max,time00
10069 ! include 'COMMON.SETUP'
10070 ! include 'COMMON.IOUNITS'
10071 ! include 'COMMON.FFIELD'
10072 ! include 'COMMON.DERIV'
10073 ! include 'COMMON.INTERACT'
10074 ! include 'COMMON.SBRIDGE'
10075 ! include 'COMMON.CHAIN'
10076 ! include 'COMMON.VAR'
10077 ! include 'COMMON.CONTROL'
10078 ! include 'COMMON.TIME1'
10079 ! include 'COMMON.MAXGRAD'
10080 ! include 'COMMON.SCCOR'
10085 write (iout,*) "sum_gradient gvdwc, gvdwx"
10087 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10088 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
10098 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
10099 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
10100 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
10103 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
10104 ! in virtual-bond-vector coordinates
10107 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
10109 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
10110 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
10112 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
10114 ! write (iout,'(i5,3f10.5,2x,f10.5)')
10115 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
10117 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
10119 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10120 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
10121 (gvdwc_scpp(j,i),j=1,3)
10123 write (iout,*) "gelc_long gvdwpp gel_loc_long"
10125 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10126 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
10127 (gelc_loc_long(j,i),j=1,3)
10134 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10135 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10136 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10137 wel_loc*gel_loc_long(j,i)+ &
10138 wcorr*gradcorr_long(j,i)+ &
10139 wcorr5*gradcorr5_long(j,i)+ &
10140 wcorr6*gradcorr6_long(j,i)+ &
10141 wturn6*gcorr6_turn_long(j,i)+ &
10142 wstrain*ghpbc(j,i) &
10143 +wliptran*gliptranc(j,i) &
10144 +welec*gshieldc(j,i) &
10145 +wcorr*gshieldc_ec(j,i) &
10146 +wturn3*gshieldc_t3(j,i)&
10147 +wturn4*gshieldc_t4(j,i)&
10148 +wel_loc*gshieldc_ll(j,i)&
10149 +wtube*gg_tube(j,i)
10158 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10159 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10160 welec*gelc_long(j,i)+ &
10161 wbond*gradb(j,i)+ &
10162 wel_loc*gel_loc_long(j,i)+ &
10163 wcorr*gradcorr_long(j,i)+ &
10164 wcorr5*gradcorr5_long(j,i)+ &
10165 wcorr6*gradcorr6_long(j,i)+ &
10166 wturn6*gcorr6_turn_long(j,i)+ &
10167 wstrain*ghpbc(j,i) &
10168 +wliptran*gliptranc(j,i) &
10169 +welec*gshieldc(j,i)&
10170 +wcorr*gshieldc_ec(j,i) &
10171 +wturn4*gshieldc_t4(j,i) &
10172 +wel_loc*gshieldc_ll(j,i)&
10173 +wtube*gg_tube(j,i)
10181 if (nfgtasks.gt.1) then
10184 write (iout,*) "gradbufc before allreduce"
10186 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10192 gradbufc_sum(j,i)=gradbufc(j,i)
10195 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
10196 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
10197 ! time_reduce=time_reduce+MPI_Wtime()-time00
10199 ! write (iout,*) "gradbufc_sum after allreduce"
10201 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
10206 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
10210 gradbufc(k,i)=0.0d0
10214 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
10215 write (iout,*) (i," jgrad_start",jgrad_start(i),&
10216 " jgrad_end ",jgrad_end(i),&
10217 i=igrad_start,igrad_end)
10220 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
10221 ! do not parallelize this part.
10223 ! do i=igrad_start,igrad_end
10224 ! do j=jgrad_start(i),jgrad_end(i)
10226 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
10231 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10235 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10239 write (iout,*) "gradbufc after summing"
10241 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10249 write (iout,*) "gradbufc"
10251 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10258 gradbufc_sum(j,i)=gradbufc(j,i)
10259 gradbufc(j,i)=0.0d0
10263 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10267 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10272 ! gradbufc(k,i)=0.0d0
10276 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
10282 write (iout,*) "gradbufc after summing"
10284 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10293 gradbufc(k,nres)=0.0d0
10295 !el----------------
10296 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
10297 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
10298 !el-----------------
10302 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10303 wel_loc*gel_loc(j,i)+ &
10304 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10305 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10306 wel_loc*gel_loc_long(j,i)+ &
10307 wcorr*gradcorr_long(j,i)+ &
10308 wcorr5*gradcorr5_long(j,i)+ &
10309 wcorr6*gradcorr6_long(j,i)+ &
10310 wturn6*gcorr6_turn_long(j,i))+ &
10311 wbond*gradb(j,i)+ &
10312 wcorr*gradcorr(j,i)+ &
10313 wturn3*gcorr3_turn(j,i)+ &
10314 wturn4*gcorr4_turn(j,i)+ &
10315 wcorr5*gradcorr5(j,i)+ &
10316 wcorr6*gradcorr6(j,i)+ &
10317 wturn6*gcorr6_turn(j,i)+ &
10318 wsccor*gsccorc(j,i) &
10319 +wscloc*gscloc(j,i) &
10320 +wliptran*gliptranc(j,i) &
10321 +welec*gshieldc(j,i) &
10322 +welec*gshieldc_loc(j,i) &
10323 +wcorr*gshieldc_ec(j,i) &
10324 +wcorr*gshieldc_loc_ec(j,i) &
10325 +wturn3*gshieldc_t3(j,i) &
10326 +wturn3*gshieldc_loc_t3(j,i) &
10327 +wturn4*gshieldc_t4(j,i) &
10328 +wturn4*gshieldc_loc_t4(j,i) &
10329 +wel_loc*gshieldc_ll(j,i) &
10330 +wel_loc*gshieldc_loc_ll(j,i) &
10331 +wtube*gg_tube(j,i)
10335 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10336 wel_loc*gel_loc(j,i)+ &
10337 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10338 welec*gelc_long(j,i)+ &
10339 wel_loc*gel_loc_long(j,i)+ &
10340 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
10341 wcorr5*gradcorr5_long(j,i)+ &
10342 wcorr6*gradcorr6_long(j,i)+ &
10343 wturn6*gcorr6_turn_long(j,i))+ &
10344 wbond*gradb(j,i)+ &
10345 wcorr*gradcorr(j,i)+ &
10346 wturn3*gcorr3_turn(j,i)+ &
10347 wturn4*gcorr4_turn(j,i)+ &
10348 wcorr5*gradcorr5(j,i)+ &
10349 wcorr6*gradcorr6(j,i)+ &
10350 wturn6*gcorr6_turn(j,i)+ &
10351 wsccor*gsccorc(j,i) &
10352 +wscloc*gscloc(j,i) &
10353 +wliptran*gliptranc(j,i) &
10354 +welec*gshieldc(j,i) &
10355 +welec*gshieldc_loc(j,) &
10356 +wcorr*gshieldc_ec(j,i) &
10357 +wcorr*gshieldc_loc_ec(j,i) &
10358 +wturn3*gshieldc_t3(j,i) &
10359 +wturn3*gshieldc_loc_t3(j,i) &
10360 +wturn4*gshieldc_t4(j,i) &
10361 +wturn4*gshieldc_loc_t4(j,i) &
10362 +wel_loc*gshieldc_ll(j,i) &
10363 +wel_loc*gshieldc_loc_ll(j,i) &
10364 +wtube*gg_tube(j,i)
10369 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
10370 wbond*gradbx(j,i)+ &
10371 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
10372 wsccor*gsccorx(j,i) &
10373 +wscloc*gsclocx(j,i) &
10374 +wliptran*gliptranx(j,i) &
10375 +welec*gshieldx(j,i) &
10376 +wcorr*gshieldx_ec(j,i) &
10377 +wturn3*gshieldx_t3(j,i) &
10378 +wturn4*gshieldx_t4(j,i) &
10379 +wel_loc*gshieldx_ll(j,i)&
10380 +wtube*gg_tube_sc(j,i)
10386 write (iout,*) "gloc before adding corr"
10388 write (iout,*) i,gloc(i,icg)
10392 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
10393 +wcorr5*g_corr5_loc(i) &
10394 +wcorr6*g_corr6_loc(i) &
10395 +wturn4*gel_loc_turn4(i) &
10396 +wturn3*gel_loc_turn3(i) &
10397 +wturn6*gel_loc_turn6(i) &
10398 +wel_loc*gel_loc_loc(i)
10401 write (iout,*) "gloc after adding corr"
10403 write (iout,*) i,gloc(i,icg)
10407 if (nfgtasks.gt.1) then
10410 gradbufc(j,i)=gradc(j,i,icg)
10411 gradbufx(j,i)=gradx(j,i,icg)
10415 glocbuf(i)=gloc(i,icg)
10419 write (iout,*) "gloc_sc before reduce"
10422 write (iout,*) i,j,gloc_sc(j,i,icg)
10429 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
10433 call MPI_Barrier(FG_COMM,IERR)
10434 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
10436 call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
10437 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10438 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,&
10439 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10440 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
10441 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10442 time_reduce=time_reduce+MPI_Wtime()-time00
10443 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
10444 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10445 time_reduce=time_reduce+MPI_Wtime()-time00
10448 write (iout,*) "gloc_sc after reduce"
10451 write (iout,*) i,j,gloc_sc(j,i,icg)
10457 write (iout,*) "gloc after reduce"
10459 write (iout,*) i,gloc(i,icg)
10464 if (gnorm_check) then
10466 ! Compute the maximum elements of the gradient
10469 gvdwc_scp_max=0.0d0
10476 gcorr3_turn_max=0.0d0
10477 gcorr4_turn_max=0.0d0
10478 gradcorr5_max=0.0d0
10479 gradcorr6_max=0.0d0
10480 gcorr6_turn_max=0.0d0
10484 gradx_scp_max=0.0d0
10490 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
10491 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
10492 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
10493 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
10494 gvdwc_scp_max=gvdwc_scp_norm
10495 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
10496 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
10497 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
10498 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
10499 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
10500 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
10501 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
10502 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
10503 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
10504 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
10505 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
10506 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
10507 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
10509 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
10510 gcorr3_turn_max=gcorr3_turn_norm
10511 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
10513 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
10514 gcorr4_turn_max=gcorr4_turn_norm
10515 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
10516 if (gradcorr5_norm.gt.gradcorr5_max) &
10517 gradcorr5_max=gradcorr5_norm
10518 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
10519 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
10520 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
10522 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
10523 gcorr6_turn_max=gcorr6_turn_norm
10524 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
10525 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
10526 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
10527 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
10528 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
10529 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
10530 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
10531 if (gradx_scp_norm.gt.gradx_scp_max) &
10532 gradx_scp_max=gradx_scp_norm
10533 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
10534 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
10535 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
10536 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
10537 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
10538 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
10539 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
10540 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
10544 open(istat,file=statname,position="append")
10546 open(istat,file=statname,access="append")
10548 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
10549 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
10550 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
10551 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
10552 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
10553 gsccorx_max,gsclocx_max
10555 if (gvdwc_max.gt.1.0d4) then
10556 write (iout,*) "gvdwc gvdwx gradb gradbx"
10558 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
10559 gradb(j,i),gradbx(j,i),j=1,3)
10561 call pdbout(0.0d0,'cipiszcze',iout)
10568 write (iout,*) "gradc gradx gloc"
10570 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
10571 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
10576 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
10579 end subroutine sum_gradient
10580 !-----------------------------------------------------------------------------
10582 ! implicit real*8 (a-h,o-z)
10584 ! include 'DIMENSIONS'
10585 ! include 'COMMON.CHAIN'
10586 ! include 'COMMON.DERIV'
10587 ! include 'COMMON.CALC'
10588 ! include 'COMMON.IOUNITS'
10589 real(kind=8), dimension(3) :: dcosom1,dcosom2
10591 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
10592 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
10593 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
10594 -2.0D0*alf12*eps3der+sigder*sigsq_om12
10598 ! eom12=evdwij*eps1_om12
10600 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
10602 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
10603 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
10604 !C print *,sss_ele_cut,'in sc_grad'
10606 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
10607 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
10610 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
10611 !C print *,'gg',k,gg(k)
10613 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
10614 ! write (iout,*) "gg",(gg(k),k=1,3)
10616 gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
10617 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
10618 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
10621 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
10622 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
10623 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
10626 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
10627 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
10628 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
10629 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
10632 ! Calculate the components of the gradient in DC and X
10636 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
10640 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
10641 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
10644 end subroutine sc_grad
10646 !-----------------------------------------------------------------------------
10647 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
10650 ! implicit real*8 (a-h,o-z)
10651 ! include 'DIMENSIONS'
10652 ! include 'COMMON.LOCAL'
10653 ! include 'COMMON.IOUNITS'
10654 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
10655 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
10656 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
10657 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
10658 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
10660 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
10661 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
10662 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
10663 !el local variables
10665 delthec=thetai-thet_pred_mean
10666 delthe0=thetai-theta0i
10667 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
10668 t3 = thetai-thet_pred_mean
10672 t14 = t12+t6*sigsqtc
10674 t21 = thetai-theta0i
10680 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
10681 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
10682 *(-t12*t9-ak*sig0inv*t27)
10684 end subroutine mixder
10686 !-----------------------------------------------------------------------------
10688 !-----------------------------------------------------------------------------
10690 !-----------------------------------------------------------------------------
10691 ! This subroutine calculates the derivatives of the consecutive virtual
10692 ! bond vectors and the SC vectors in the virtual-bond angles theta and
10693 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
10694 ! in the angles alpha and omega, describing the location of a side chain
10695 ! in its local coordinate system.
10697 ! The derivatives are stored in the following arrays:
10699 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
10700 ! The structure is as follows:
10702 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
10703 ! 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)
10704 ! . . . . . . . . . . . . . . . . . .
10705 ! 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)
10709 ! 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)
10711 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
10712 ! The structure is same as above.
10714 ! DCDS - the derivatives of the side chain vectors in the local spherical
10715 ! andgles alph and omega:
10717 ! 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)
10718 ! 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)
10722 ! 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)
10724 ! Version of March '95, based on an early version of November '91.
10726 !**********************************************************************
10727 ! implicit real*8 (a-h,o-z)
10728 ! include 'DIMENSIONS'
10729 ! include 'COMMON.VAR'
10730 ! include 'COMMON.CHAIN'
10731 ! include 'COMMON.DERIV'
10732 ! include 'COMMON.GEO'
10733 ! include 'COMMON.LOCAL'
10734 ! include 'COMMON.INTERACT'
10735 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
10736 real(kind=8),dimension(3,3) :: dp,temp
10737 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
10738 real(kind=8),dimension(3) :: xx,xx1
10739 !el local variables
10740 integer :: i,k,l,j,m,ind,ind1,jjj
10741 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
10742 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
10743 sint2,xp,yp,xxp,yyp,zzp,dj
10745 ! common /przechowalnia/ fromto
10746 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
10747 ! get the position of the jth ijth fragment of the chain coordinate system
10748 ! in the fromto array.
10749 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
10751 ! maxdim=(nres-1)*(nres-2)/2
10752 ! allocate(dcdv(6,maxdim),dxds(6,nres))
10753 ! calculate the derivatives of transformation matrix elements in theta
10756 !el call flush(iout) !el
10758 rdt(1,1,i)=-rt(1,2,i)
10759 rdt(1,2,i)= rt(1,1,i)
10761 rdt(2,1,i)=-rt(2,2,i)
10762 rdt(2,2,i)= rt(2,1,i)
10764 rdt(3,1,i)=-rt(3,2,i)
10765 rdt(3,2,i)= rt(3,1,i)
10769 ! derivatives in phi
10775 drt(2,1,i)= rt(3,1,i)
10776 drt(2,2,i)= rt(3,2,i)
10777 drt(2,3,i)= rt(3,3,i)
10778 drt(3,1,i)=-rt(2,1,i)
10779 drt(3,2,i)=-rt(2,2,i)
10780 drt(3,3,i)=-rt(2,3,i)
10783 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
10789 temp(k,l)=rt(k,l,i)
10794 fromto(k,l,ind)=temp(k,l)
10803 dpkl=dpkl+temp(k,m)*rt(m,l,j)
10806 fromto(k,l,ind)=dpkl
10817 ! Calculate derivatives.
10823 ! Derivatives of DC(i+1) in theta(i+2)
10829 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
10832 prordt(j,k,i)=dp(j,k)
10835 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
10838 ! Derivatives of SC(i+1) in theta(i+2)
10840 xx1(1)=-0.5D0*xloc(2,i+1)
10841 xx1(2)= 0.5D0*xloc(1,i+1)
10845 xj=xj+r(j,k,i)*xx1(k)
10852 rj=rj+prod(j,k,i)*xx(k)
10857 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
10858 ! than the other off-diagonal derivatives.
10863 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
10865 dxdv(j,ind1+1)=dxoiij
10867 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
10869 ! Derivatives of DC(i+1) in phi(i+2)
10875 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
10878 prodrt(j,k,i)=dp(j,k)
10880 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
10883 ! Derivatives of SC(i+1) in phi(i+2)
10886 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
10887 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
10891 rj=rj+prod(j,k,i)*xx(k)
10896 ! Derivatives of SC(i+1) in phi(i+3).
10901 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
10903 dxdv(j+3,ind1+1)=dxoiij
10906 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
10907 ! theta(nres) and phi(i+3) thru phi(nres).
10911 ind=indmat(i+1,j+1)
10912 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
10917 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
10922 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
10923 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
10924 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
10925 ! Derivatives of virtual-bond vectors in theta
10927 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
10929 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
10930 ! Derivatives of SC vectors in theta
10934 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
10936 dxdv(k,ind1+1)=dxoijk
10939 !--- Calculate the derivatives in phi
10945 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
10951 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
10956 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
10958 dxdv(k+3,ind1+1)=dxoijk
10963 ! Derivatives in alpha and omega:
10966 ! dsci=dsc(itype(i))
10971 if(alphi.ne.alphi) alphi=100.0
10972 if(omegi.ne.omegi) omegi=-100.0
10977 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
10978 cosalphi=dcos(alphi)
10979 sinalphi=dsin(alphi)
10980 cosomegi=dcos(omegi)
10981 sinomegi=dsin(omegi)
10982 temp(1,1)=-dsci*sinalphi
10983 temp(2,1)= dsci*cosalphi*cosomegi
10984 temp(3,1)=-dsci*cosalphi*sinomegi
10986 temp(2,2)=-dsci*sinalphi*sinomegi
10987 temp(3,2)=-dsci*sinalphi*cosomegi
10988 theta2=pi-0.5D0*theta(i+1)
10992 !d print *,((temp(l,k),l=1,3),k=1,2)
10996 xxp= xp*cost2+yp*sint2
10997 yyp=-xp*sint2+yp*cost2
11000 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
11001 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
11005 dj=dj+prod(k,l,i-1)*xx(l)
11013 end subroutine cartder
11014 !-----------------------------------------------------------------------------
11016 !-----------------------------------------------------------------------------
11017 subroutine check_cartgrad
11018 ! Check the gradient of Cartesian coordinates in internal coordinates.
11019 ! implicit real*8 (a-h,o-z)
11020 ! include 'DIMENSIONS'
11021 ! include 'COMMON.IOUNITS'
11022 ! include 'COMMON.VAR'
11023 ! include 'COMMON.CHAIN'
11024 ! include 'COMMON.GEO'
11025 ! include 'COMMON.LOCAL'
11026 ! include 'COMMON.DERIV'
11027 real(kind=8),dimension(6,nres) :: temp
11028 real(kind=8),dimension(3) :: xx,gg
11029 integer :: i,k,j,ii
11030 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
11031 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11033 ! Check the gradient of the virtual-bond and SC vectors in the internal
11039 write (iout,'(a)') '**************** dx/dalpha'
11043 alph(i)=alph(i)+aincr
11045 temp(k,i)=dc(k,nres+i)
11049 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11050 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
11052 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11053 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
11059 write (iout,'(a)') '**************** dx/domega'
11063 omeg(i)=omeg(i)+aincr
11065 temp(k,i)=dc(k,nres+i)
11069 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11070 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
11071 (aincr*dabs(dxds(k+3,i))+aincr))
11073 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11074 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
11080 write (iout,'(a)') '**************** dx/dtheta'
11084 theta(i)=theta(i)+aincr
11087 temp(k,j)=dc(k,nres+j)
11093 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
11095 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11096 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
11097 (aincr*dabs(dxdv(k,ii))+aincr))
11099 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11100 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
11107 write (iout,'(a)') '***************** dx/dphi'
11110 phi(i)=phi(i)+aincr
11113 temp(k,j)=dc(k,nres+j)
11121 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11122 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
11123 (aincr*dabs(dxdv(k+3,ii))+aincr))
11125 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11126 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11129 phi(i)=phi(i)-aincr
11132 write (iout,'(a)') '****************** ddc/dtheta'
11135 theta(i+2)=thet+aincr
11146 gg(k)=(dc(k,j)-temp(k,j))/aincr
11147 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
11148 (aincr*dabs(dcdv(k,ii))+aincr))
11150 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11151 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
11161 write (iout,'(a)') '******************* ddc/dphi'
11164 phi(i+3)=phii+aincr
11175 gg(k)=(dc(k,j)-temp(k,j))/aincr
11176 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
11177 (aincr*dabs(dcdv(k+3,ii))+aincr))
11179 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11180 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11191 end subroutine check_cartgrad
11192 !-----------------------------------------------------------------------------
11193 subroutine check_ecart
11194 ! Check the gradient of the energy in Cartesian coordinates.
11195 ! implicit real*8 (a-h,o-z)
11196 ! include 'DIMENSIONS'
11197 ! include 'COMMON.CHAIN'
11198 ! include 'COMMON.DERIV'
11199 ! include 'COMMON.IOUNITS'
11200 ! include 'COMMON.VAR'
11201 ! include 'COMMON.CONTACTS'
11203 !el integer :: icall
11204 !el common /srutu/ icall
11205 real(kind=8),dimension(6) :: ggg
11206 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11207 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11208 real(kind=8),dimension(6,nres) :: grad_s
11209 real(kind=8),dimension(0:n_ene) :: energia,energia1
11210 integer :: uiparm(1)
11211 real(kind=8) :: urparm(1)
11213 integer :: nf,i,j,k
11214 real(kind=8) :: aincr,etot,etot1
11220 print '(a)','CG processor',me,' calling CHECK_CART.',aincr
11223 call geom_to_var(nvar,x)
11224 call etotal(energia)
11226 !el call enerprint(energia)
11227 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
11230 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11234 grad_s(j,i)=gradc(j,i,icg)
11235 grad_s(j+3,i)=gradx(j,i,icg)
11239 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11244 ddx(j)=dc(j,i+nres)
11247 dc(j,i)=dc(j,i)+aincr
11249 c(j,k)=c(j,k)+aincr
11250 c(j,k+nres)=c(j,k+nres)+aincr
11252 call etotal(energia1)
11254 ggg(j)=(etot1-etot)/aincr
11257 c(j,k)=c(j,k)-aincr
11258 c(j,k+nres)=c(j,k+nres)-aincr
11262 c(j,i+nres)=c(j,i+nres)+aincr
11263 dc(j,i+nres)=dc(j,i+nres)+aincr
11264 call etotal(energia1)
11266 ggg(j+3)=(etot1-etot)/aincr
11268 dc(j,i+nres)=ddx(j)
11270 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
11271 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
11274 end subroutine check_ecart
11276 !-----------------------------------------------------------------------------
11277 subroutine check_ecartint
11278 ! Check the gradient of the energy in Cartesian coordinates.
11279 use io_base, only: intout
11280 ! implicit real*8 (a-h,o-z)
11281 ! include 'DIMENSIONS'
11282 ! include 'COMMON.CONTROL'
11283 ! include 'COMMON.CHAIN'
11284 ! include 'COMMON.DERIV'
11285 ! include 'COMMON.IOUNITS'
11286 ! include 'COMMON.VAR'
11287 ! include 'COMMON.CONTACTS'
11288 ! include 'COMMON.MD'
11289 ! include 'COMMON.LOCAL'
11290 ! include 'COMMON.SPLITELE'
11292 !el integer :: icall
11293 !el common /srutu/ icall
11294 real(kind=8),dimension(6) :: ggg,ggg1
11295 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
11296 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11297 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
11298 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11299 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11300 real(kind=8),dimension(0:n_ene) :: energia,energia1
11301 integer :: uiparm(1)
11302 real(kind=8) :: urparm(1)
11304 integer :: i,j,k,nf
11305 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
11313 ! call intcartderiv
11314 ! call checkintcartgrad
11317 write(iout,*) 'Calling CHECK_ECARTINT.'
11320 write (iout,*) "Before geom_to_var"
11321 call geom_to_var(nvar,x)
11322 write (iout,*) "after geom_to_var"
11323 write (iout,*) "split_ene ",split_ene
11325 if (.not.split_ene) then
11326 write(iout,*) 'Calling CHECK_ECARTINT if'
11327 call etotal(energia)
11328 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11330 write (iout,*) "etot",etot
11332 !el call enerprint(energia)
11333 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11335 write (iout,*) "enter cartgrad"
11338 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11339 write (iout,*) "exit cartgrad"
11343 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11346 grad_s(j,0)=gcart(j,0)
11348 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11351 grad_s(j,i)=gcart(j,i)
11352 grad_s(j+3,i)=gxcart(j,i)
11356 write(iout,*) 'Calling CHECK_ECARTIN else.'
11357 !- split gradient check
11359 call etotal_long(energia)
11360 !el call enerprint(energia)
11362 write (iout,*) "enter cartgrad"
11365 write (iout,*) "exit cartgrad"
11368 write (iout,*) "longrange 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_s(j,0)=gcart(j,0)
11378 grad_s(j,i)=gcart(j,i)
11379 grad_s(j+3,i)=gxcart(j,i)
11383 call etotal_short(energia)
11384 !el call enerprint(energia)
11386 write (iout,*) "enter cartgrad"
11389 write (iout,*) "exit cartgrad"
11392 write (iout,*) "shortrange grad"
11394 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11395 (gxcart(j,i),j=1,3)
11398 grad_s1(j,0)=gcart(j,0)
11402 grad_s1(j,i)=gcart(j,i)
11403 grad_s1(j+3,i)=gxcart(j,i)
11407 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11411 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
11412 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
11415 dcnorm_safe1(j)=dc_norm(j,i-1)
11416 dcnorm_safe2(j)=dc_norm(j,i)
11417 dxnorm_safe(j)=dc_norm(j,i+nres)
11420 c(j,i)=ddc(j)+aincr
11421 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
11422 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
11423 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11424 dc(j,i)=c(j,i+1)-c(j,i)
11425 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11426 call int_from_cart1(.false.)
11427 if (.not.split_ene) then
11428 call etotal(energia1)
11430 write (iout,*) "ij",i,j," etot1",etot1
11433 call etotal_long(energia1)
11435 call etotal_short(energia1)
11438 !- end split gradient
11439 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11440 c(j,i)=ddc(j)-aincr
11441 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
11442 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
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 call int_from_cart1(.false.)
11447 if (.not.split_ene) then
11448 call etotal(energia1)
11450 write (iout,*) "ij",i,j," etot2",etot2
11451 ggg(j)=(etot1-etot2)/(2*aincr)
11454 call etotal_long(energia1)
11456 ggg(j)=(etot11-etot21)/(2*aincr)
11457 call etotal_short(energia1)
11459 ggg1(j)=(etot12-etot22)/(2*aincr)
11460 !- end split gradient
11461 ! write (iout,*) "etot21",etot21," etot22",etot22
11463 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11465 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
11466 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
11467 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11468 dc(j,i)=c(j,i+1)-c(j,i)
11469 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11470 dc_norm(j,i-1)=dcnorm_safe1(j)
11471 dc_norm(j,i)=dcnorm_safe2(j)
11472 dc_norm(j,i+nres)=dxnorm_safe(j)
11475 c(j,i+nres)=ddx(j)+aincr
11476 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11477 call int_from_cart1(.false.)
11478 if (.not.split_ene) then
11479 call etotal(energia1)
11483 call etotal_long(energia1)
11485 call etotal_short(energia1)
11488 !- end split gradient
11489 c(j,i+nres)=ddx(j)-aincr
11490 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11491 call int_from_cart1(.false.)
11492 if (.not.split_ene) then
11493 call etotal(energia1)
11495 ggg(j+3)=(etot1-etot2)/(2*aincr)
11498 call etotal_long(energia1)
11500 ggg(j+3)=(etot11-etot21)/(2*aincr)
11501 call etotal_short(energia1)
11503 ggg1(j+3)=(etot12-etot22)/(2*aincr)
11504 !- end split gradient
11506 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11508 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11509 dc_norm(j,i+nres)=dxnorm_safe(j)
11510 call int_from_cart1(.false.)
11512 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11513 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
11514 if (split_ene) then
11515 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11516 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
11518 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11519 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
11520 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
11524 end subroutine check_ecartint
11526 !-----------------------------------------------------------------------------
11527 subroutine check_ecartint
11528 ! Check the gradient of the energy in Cartesian coordinates.
11529 use io_base, only: intout
11530 ! implicit real*8 (a-h,o-z)
11531 ! include 'DIMENSIONS'
11532 ! include 'COMMON.CONTROL'
11533 ! include 'COMMON.CHAIN'
11534 ! include 'COMMON.DERIV'
11535 ! include 'COMMON.IOUNITS'
11536 ! include 'COMMON.VAR'
11537 ! include 'COMMON.CONTACTS'
11538 ! include 'COMMON.MD'
11539 ! include 'COMMON.LOCAL'
11540 ! include 'COMMON.SPLITELE'
11542 !el integer :: icall
11543 !el common /srutu/ icall
11544 real(kind=8),dimension(6) :: ggg,ggg1
11545 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11546 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11547 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
11548 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11549 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11550 real(kind=8),dimension(0:n_ene) :: energia,energia1
11551 integer :: uiparm(1)
11552 real(kind=8) :: urparm(1)
11554 integer :: i,j,k,nf
11555 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
11563 ! call intcartderiv
11564 ! call checkintcartgrad
11567 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
11570 call geom_to_var(nvar,x)
11571 if (.not.split_ene) then
11572 call etotal(energia)
11574 !el call enerprint(energia)
11576 write (iout,*) "enter cartgrad"
11579 write (iout,*) "exit cartgrad"
11583 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11586 grad_s(j,0)=gcart(j,0)
11590 grad_s(j,i)=gcart(j,i)
11591 grad_s(j+3,i)=gxcart(j,i)
11595 !- split gradient check
11597 call etotal_long(energia)
11598 !el call enerprint(energia)
11600 write (iout,*) "enter cartgrad"
11603 write (iout,*) "exit cartgrad"
11606 write (iout,*) "longrange 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_s(j,0)=gcart(j,0)
11616 grad_s(j,i)=gcart(j,i)
11617 grad_s(j+3,i)=gxcart(j,i)
11621 call etotal_short(energia)
11622 !el call enerprint(energia)
11624 write (iout,*) "enter cartgrad"
11627 write (iout,*) "exit cartgrad"
11630 write (iout,*) "shortrange grad"
11632 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11633 (gxcart(j,i),j=1,3)
11636 grad_s1(j,0)=gcart(j,0)
11640 grad_s1(j,i)=gcart(j,i)
11641 grad_s1(j+3,i)=gxcart(j,i)
11645 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11650 ddx(j)=dc(j,i+nres)
11652 dcnorm_safe(k)=dc_norm(k,i)
11653 dxnorm_safe(k)=dc_norm(k,i+nres)
11657 dc(j,i)=ddc(j)+aincr
11658 call chainbuild_cart
11660 ! Broadcast the order to compute internal coordinates to the slaves.
11661 ! if (nfgtasks.gt.1)
11662 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
11664 ! call int_from_cart1(.false.)
11665 if (.not.split_ene) then
11666 call etotal(energia1)
11670 call etotal_long(energia1)
11672 call etotal_short(energia1)
11674 ! write (iout,*) "etot11",etot11," etot12",etot12
11676 !- end split gradient
11677 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11678 dc(j,i)=ddc(j)-aincr
11679 call chainbuild_cart
11680 ! call int_from_cart1(.false.)
11681 if (.not.split_ene) then
11682 call etotal(energia1)
11684 ggg(j)=(etot1-etot2)/(2*aincr)
11687 call etotal_long(energia1)
11689 ggg(j)=(etot11-etot21)/(2*aincr)
11690 call etotal_short(energia1)
11692 ggg1(j)=(etot12-etot22)/(2*aincr)
11693 !- end split gradient
11694 ! write (iout,*) "etot21",etot21," etot22",etot22
11696 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11698 call chainbuild_cart
11701 dc(j,i+nres)=ddx(j)+aincr
11702 call chainbuild_cart
11703 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
11704 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
11705 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
11706 ! write (iout,*) "dxnormnorm",dsqrt(
11707 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
11708 ! write (iout,*) "dxnormnormsafe",dsqrt(
11709 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
11711 if (.not.split_ene) then
11712 call etotal(energia1)
11716 call etotal_long(energia1)
11718 call etotal_short(energia1)
11721 !- end split gradient
11722 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11723 dc(j,i+nres)=ddx(j)-aincr
11724 call chainbuild_cart
11725 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
11726 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
11727 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
11729 ! write (iout,*) "dxnormnorm",dsqrt(
11730 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
11731 ! write (iout,*) "dxnormnormsafe",dsqrt(
11732 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
11733 if (.not.split_ene) then
11734 call etotal(energia1)
11736 ggg(j+3)=(etot1-etot2)/(2*aincr)
11739 call etotal_long(energia1)
11741 ggg(j+3)=(etot11-etot21)/(2*aincr)
11742 call etotal_short(energia1)
11744 ggg1(j+3)=(etot12-etot22)/(2*aincr)
11745 !- end split gradient
11747 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11748 dc(j,i+nres)=ddx(j)
11749 call chainbuild_cart
11751 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11752 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
11753 if (split_ene) then
11754 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11755 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
11757 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11758 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
11759 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
11763 end subroutine check_ecartint
11765 !-----------------------------------------------------------------------------
11766 subroutine check_eint
11767 ! Check the gradient of energy in internal coordinates.
11768 ! implicit real*8 (a-h,o-z)
11769 ! include 'DIMENSIONS'
11770 ! include 'COMMON.CHAIN'
11771 ! include 'COMMON.DERIV'
11772 ! include 'COMMON.IOUNITS'
11773 ! include 'COMMON.VAR'
11774 ! include 'COMMON.GEO'
11776 !el integer :: icall
11777 !el common /srutu/ icall
11778 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
11779 integer :: uiparm(1)
11780 real(kind=8) :: urparm(1)
11781 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
11782 character(len=6) :: key
11785 real(kind=8) :: xi,aincr,etot,etot1,etot2
11788 print '(a)','Calling CHECK_INT.'
11792 call geom_to_var(nvar,x)
11793 call var_to_geom(nvar,x)
11797 call etotal(energia)
11799 !el call enerprint(energia)
11802 if (MyID.ne.BossID) then
11803 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
11811 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
11812 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
11813 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
11817 x(i)=xi-0.5D0*aincr
11818 call var_to_geom(nvar,x)
11820 call etotal(energia1)
11822 x(i)=xi+0.5D0*aincr
11823 call var_to_geom(nvar,x)
11825 call etotal(energia2)
11827 gg(i)=(etot2-etot1)/aincr
11828 write (iout,*) i,etot1,etot2
11831 write (iout,'(/2a)')' Variable Numerical Analytical',&
11834 if (i.le.nphi) then
11837 else if (i.le.nphi+ntheta) then
11840 else if (i.le.nphi+ntheta+nside) then
11844 ii=i-(nphi+ntheta+nside)
11847 write (iout,'(i3,a,i3,3(1pd16.6))') &
11848 i,key,ii,gg(i),gana(i),&
11849 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
11852 end subroutine check_eint
11853 !-----------------------------------------------------------------------------
11855 !-----------------------------------------------------------------------------
11856 subroutine Econstr_back
11857 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
11858 ! implicit real*8 (a-h,o-z)
11859 ! include 'DIMENSIONS'
11860 ! include 'COMMON.CONTROL'
11861 ! include 'COMMON.VAR'
11862 ! include 'COMMON.MD'
11865 ! include 'COMMON.LANGEVIN'
11867 ! include 'COMMON.LANGEVIN.lang0'
11869 ! include 'COMMON.CHAIN'
11870 ! include 'COMMON.DERIV'
11871 ! include 'COMMON.GEO'
11872 ! include 'COMMON.LOCAL'
11873 ! include 'COMMON.INTERACT'
11874 ! include 'COMMON.IOUNITS'
11875 ! include 'COMMON.NAMES'
11876 ! include 'COMMON.TIME1'
11877 integer :: i,j,ii,k
11878 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
11880 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
11881 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
11882 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
11889 duscdiff(j,i)=0.0d0
11890 duscdiffx(j,i)=0.0d0
11894 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
11896 ! Deviations from theta angles
11899 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
11900 dtheta_i=theta(j)-thetaref(j)
11901 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
11902 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
11904 utheta(i)=utheta_i/(ii-1)
11906 ! Deviations from gamma angles
11909 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
11910 dgamma_i=pinorm(phi(j)-phiref(j))
11911 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
11912 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
11913 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
11914 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
11916 ugamma(i)=ugamma_i/(ii-2)
11918 ! Deviations from local SC geometry
11921 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
11922 dxx=xxtab(j)-xxref(j)
11923 dyy=yytab(j)-yyref(j)
11924 dzz=zztab(j)-zzref(j)
11925 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
11927 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
11928 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
11930 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
11931 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
11933 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
11934 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
11937 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
11938 ! & xxref(j),yyref(j),zzref(j)
11940 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
11941 ! write (iout,*) i," uscdiff",uscdiff(i)
11943 ! Put together deviations from local geometry
11945 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
11946 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
11947 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
11948 ! & " uconst_back",uconst_back
11949 utheta(i)=dsqrt(utheta(i))
11950 ugamma(i)=dsqrt(ugamma(i))
11951 uscdiff(i)=dsqrt(uscdiff(i))
11954 end subroutine Econstr_back
11955 !-----------------------------------------------------------------------------
11956 ! energy_p_new-sep_barrier.F
11957 !-----------------------------------------------------------------------------
11958 real(kind=8) function sscale(r)
11959 ! include "COMMON.SPLITELE"
11960 real(kind=8) :: r,gamm
11961 if(r.lt.r_cut-rlamb) then
11963 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
11964 gamm=(r-(r_cut-rlamb))/rlamb
11965 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
11970 end function sscale
11971 real(kind=8) function sscale_grad(r)
11972 ! include "COMMON.SPLITELE"
11973 real(kind=8) :: r,gamm
11974 if(r.lt.r_cut-rlamb) then
11976 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
11977 gamm=(r-(r_cut-rlamb))/rlamb
11978 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
11983 end function sscale_grad
11985 !!!!!!!!!! PBCSCALE
11986 real(kind=8) function sscale_ele(r)
11987 ! include "COMMON.SPLITELE"
11988 real(kind=8) :: r,gamm
11989 if(r.lt.r_cut_ele-rlamb_ele) then
11991 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
11992 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
11993 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
11998 end function sscale_ele
12000 real(kind=8) function sscagrad_ele(r)
12001 real(kind=8) :: r,gamm
12002 ! include "COMMON.SPLITELE"
12003 if(r.lt.r_cut_ele-rlamb_ele) then
12005 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12006 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12007 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
12012 end function sscagrad_ele
12013 real(kind=8) function sscalelip(r)
12014 real(kind=8) r,gamm
12015 sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
12017 end function sscalelip
12018 !C-----------------------------------------------------------------------
12019 real(kind=8) function sscagradlip(r)
12020 real(kind=8) r,gamm
12021 sscagradlip=r*(6.0d0*r-6.0d0)
12023 end function sscagradlip
12026 !-----------------------------------------------------------------------------
12027 subroutine elj_long(evdw)
12029 ! This subroutine calculates the interaction energy of nonbonded side chains
12030 ! assuming the LJ potential of interaction.
12032 ! implicit real*8 (a-h,o-z)
12033 ! include 'DIMENSIONS'
12034 ! include 'COMMON.GEO'
12035 ! include 'COMMON.VAR'
12036 ! include 'COMMON.LOCAL'
12037 ! include 'COMMON.CHAIN'
12038 ! include 'COMMON.DERIV'
12039 ! include 'COMMON.INTERACT'
12040 ! include 'COMMON.TORSION'
12041 ! include 'COMMON.SBRIDGE'
12042 ! include 'COMMON.NAMES'
12043 ! include 'COMMON.IOUNITS'
12044 ! include 'COMMON.CONTACTS'
12045 real(kind=8),parameter :: accur=1.0d-10
12046 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12047 !el local variables
12048 integer :: i,iint,j,k,itypi,itypi1,itypj
12049 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12050 real(kind=8) :: e1,e2,evdwij,evdw
12051 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12053 do i=iatsc_s,iatsc_e
12055 if (itypi.eq.ntyp1) cycle
12061 ! Calculate SC interaction energy.
12063 do iint=1,nint_gr(i)
12064 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12065 !d & 'iend=',iend(i,iint)
12066 do j=istart(i,iint),iend(i,iint)
12068 if (itypj.eq.ntyp1) cycle
12072 rij=xj*xj+yj*yj+zj*zj
12073 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12074 if (sss.lt.1.0d0) then
12076 eps0ij=eps(itypi,itypj)
12078 e1=fac*fac*aa_aq(itypi,itypj)
12079 e2=fac*bb_aq(itypi,itypj)
12081 evdw=evdw+(1.0d0-sss)*evdwij
12083 ! Calculate the components of the gradient in DC and X
12085 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
12090 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12091 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12092 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12093 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12101 gvdwc(j,i)=expon*gvdwc(j,i)
12102 gvdwx(j,i)=expon*gvdwx(j,i)
12105 !******************************************************************************
12109 ! To save time, the factor of EXPON has been extracted from ALL components
12110 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12113 !******************************************************************************
12115 end subroutine elj_long
12116 !-----------------------------------------------------------------------------
12117 subroutine elj_short(evdw)
12119 ! This subroutine calculates the interaction energy of nonbonded side chains
12120 ! assuming the LJ potential of interaction.
12122 ! implicit real*8 (a-h,o-z)
12123 ! include 'DIMENSIONS'
12124 ! include 'COMMON.GEO'
12125 ! include 'COMMON.VAR'
12126 ! include 'COMMON.LOCAL'
12127 ! include 'COMMON.CHAIN'
12128 ! include 'COMMON.DERIV'
12129 ! include 'COMMON.INTERACT'
12130 ! include 'COMMON.TORSION'
12131 ! include 'COMMON.SBRIDGE'
12132 ! include 'COMMON.NAMES'
12133 ! include 'COMMON.IOUNITS'
12134 ! include 'COMMON.CONTACTS'
12135 real(kind=8),parameter :: accur=1.0d-10
12136 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12137 !el local variables
12138 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
12139 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12140 real(kind=8) :: e1,e2,evdwij,evdw
12141 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12143 do i=iatsc_s,iatsc_e
12145 if (itypi.eq.ntyp1) cycle
12153 ! Calculate SC interaction energy.
12155 do iint=1,nint_gr(i)
12156 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12157 !d & 'iend=',iend(i,iint)
12158 do j=istart(i,iint),iend(i,iint)
12160 if (itypj.eq.ntyp1) cycle
12164 ! Change 12/1/95 to calculate four-body interactions
12165 rij=xj*xj+yj*yj+zj*zj
12166 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12167 if (sss.gt.0.0d0) then
12169 eps0ij=eps(itypi,itypj)
12171 e1=fac*fac*aa_aq(itypi,itypj)
12172 e2=fac*bb_aq(itypi,itypj)
12174 evdw=evdw+sss*evdwij
12176 ! Calculate the components of the gradient in DC and X
12178 fac=-rrij*(e1+evdwij)*sss
12183 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12184 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12185 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12186 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12194 gvdwc(j,i)=expon*gvdwc(j,i)
12195 gvdwx(j,i)=expon*gvdwx(j,i)
12198 !******************************************************************************
12202 ! To save time, the factor of EXPON has been extracted from ALL components
12203 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12206 !******************************************************************************
12208 end subroutine elj_short
12209 !-----------------------------------------------------------------------------
12210 subroutine eljk_long(evdw)
12212 ! This subroutine calculates the interaction energy of nonbonded side chains
12213 ! assuming the LJK potential of interaction.
12215 ! implicit real*8 (a-h,o-z)
12216 ! include 'DIMENSIONS'
12217 ! include 'COMMON.GEO'
12218 ! include 'COMMON.VAR'
12219 ! include 'COMMON.LOCAL'
12220 ! include 'COMMON.CHAIN'
12221 ! include 'COMMON.DERIV'
12222 ! include 'COMMON.INTERACT'
12223 ! include 'COMMON.IOUNITS'
12224 ! include 'COMMON.NAMES'
12225 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12227 !el local variables
12228 integer :: i,iint,j,k,itypi,itypi1,itypj
12229 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12230 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12231 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12233 do i=iatsc_s,iatsc_e
12235 if (itypi.eq.ntyp1) cycle
12241 ! Calculate SC interaction energy.
12243 do iint=1,nint_gr(i)
12244 do j=istart(i,iint),iend(i,iint)
12246 if (itypj.eq.ntyp1) cycle
12250 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12251 fac_augm=rrij**expon
12252 e_augm=augm(itypi,itypj)*fac_augm
12253 r_inv_ij=dsqrt(rrij)
12255 sss=sscale(rij/sigma(itypi,itypj))
12256 if (sss.lt.1.0d0) then
12257 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12258 fac=r_shift_inv**expon
12259 e1=fac*fac*aa_aq(itypi,itypj)
12260 e2=fac*bb_aq(itypi,itypj)
12261 evdwij=e_augm+e1+e2
12262 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12263 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12264 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12265 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
12266 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12267 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12268 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12269 evdw=evdw+(1.0d0-sss)*evdwij
12271 ! Calculate the components of the gradient in DC and X
12273 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12274 fac=fac*(1.0d0-sss)
12279 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12280 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12281 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12282 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12290 gvdwc(j,i)=expon*gvdwc(j,i)
12291 gvdwx(j,i)=expon*gvdwx(j,i)
12295 end subroutine eljk_long
12296 !-----------------------------------------------------------------------------
12297 subroutine eljk_short(evdw)
12299 ! This subroutine calculates the interaction energy of nonbonded side chains
12300 ! assuming the LJK potential of interaction.
12302 ! implicit real*8 (a-h,o-z)
12303 ! include 'DIMENSIONS'
12304 ! include 'COMMON.GEO'
12305 ! include 'COMMON.VAR'
12306 ! include 'COMMON.LOCAL'
12307 ! include 'COMMON.CHAIN'
12308 ! include 'COMMON.DERIV'
12309 ! include 'COMMON.INTERACT'
12310 ! include 'COMMON.IOUNITS'
12311 ! include 'COMMON.NAMES'
12312 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12314 !el local variables
12315 integer :: i,iint,j,k,itypi,itypi1,itypj
12316 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12317 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12318 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12320 do i=iatsc_s,iatsc_e
12322 if (itypi.eq.ntyp1) cycle
12328 ! Calculate SC interaction energy.
12330 do iint=1,nint_gr(i)
12331 do j=istart(i,iint),iend(i,iint)
12333 if (itypj.eq.ntyp1) cycle
12337 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12338 fac_augm=rrij**expon
12339 e_augm=augm(itypi,itypj)*fac_augm
12340 r_inv_ij=dsqrt(rrij)
12342 sss=sscale(rij/sigma(itypi,itypj))
12343 if (sss.gt.0.0d0) then
12344 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12345 fac=r_shift_inv**expon
12346 e1=fac*fac*aa_aq(itypi,itypj)
12347 e2=fac*bb_aq(itypi,itypj)
12348 evdwij=e_augm+e1+e2
12349 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12350 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12351 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12352 !d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
12353 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12354 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12355 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12356 evdw=evdw+sss*evdwij
12358 ! Calculate the components of the gradient in DC and X
12360 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12366 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12367 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12368 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12369 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12377 gvdwc(j,i)=expon*gvdwc(j,i)
12378 gvdwx(j,i)=expon*gvdwx(j,i)
12382 end subroutine eljk_short
12383 !-----------------------------------------------------------------------------
12384 subroutine ebp_long(evdw)
12386 ! This subroutine calculates the interaction energy of nonbonded side chains
12387 ! assuming the Berne-Pechukas potential of interaction.
12390 ! implicit real*8 (a-h,o-z)
12391 ! include 'DIMENSIONS'
12392 ! include 'COMMON.GEO'
12393 ! include 'COMMON.VAR'
12394 ! include 'COMMON.LOCAL'
12395 ! include 'COMMON.CHAIN'
12396 ! include 'COMMON.DERIV'
12397 ! include 'COMMON.NAMES'
12398 ! include 'COMMON.INTERACT'
12399 ! include 'COMMON.IOUNITS'
12400 ! include 'COMMON.CALC'
12402 !el integer :: icall
12403 !el common /srutu/ icall
12404 ! double precision rrsave(maxdim)
12406 !el local variables
12407 integer :: iint,itypi,itypi1,itypj
12408 real(kind=8) :: rrij,xi,yi,zi,fac
12409 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
12411 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12413 ! if (icall.eq.0) then
12419 do i=iatsc_s,iatsc_e
12421 if (itypi.eq.ntyp1) cycle
12426 dxi=dc_norm(1,nres+i)
12427 dyi=dc_norm(2,nres+i)
12428 dzi=dc_norm(3,nres+i)
12429 ! dsci_inv=dsc_inv(itypi)
12430 dsci_inv=vbld_inv(i+nres)
12432 ! Calculate SC interaction energy.
12434 do iint=1,nint_gr(i)
12435 do j=istart(i,iint),iend(i,iint)
12438 if (itypj.eq.ntyp1) cycle
12439 ! dscj_inv=dsc_inv(itypj)
12440 dscj_inv=vbld_inv(j+nres)
12441 chi1=chi(itypi,itypj)
12442 chi2=chi(itypj,itypi)
12449 alf12=0.5D0*(alf1+alf2)
12453 dxj=dc_norm(1,nres+j)
12454 dyj=dc_norm(2,nres+j)
12455 dzj=dc_norm(3,nres+j)
12456 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12458 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12460 if (sss.lt.1.0d0) then
12462 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12464 ! Calculate whole angle-dependent part of epsilon and contributions
12465 ! to its derivatives
12466 fac=(rrij*sigsq)**expon2
12467 e1=fac*fac*aa_aq(itypi,itypj)
12468 e2=fac*bb_aq(itypi,itypj)
12469 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12470 eps2der=evdwij*eps3rt
12471 eps3der=evdwij*eps2rt
12472 evdwij=evdwij*eps2rt*eps3rt
12473 evdw=evdw+evdwij*(1.0d0-sss)
12475 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12476 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12477 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12478 !d & restyp(itypi),i,restyp(itypj),j,
12479 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12480 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12481 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12484 ! Calculate gradient components.
12485 e1=e1*eps1*eps2rt**2*eps3rt**2
12486 fac=-expon*(e1+evdwij)
12489 ! Calculate radial part of the gradient
12493 ! Calculate the angular part of the gradient and sum add the contributions
12494 ! to the appropriate components of the Cartesian gradient.
12495 call sc_grad_scale(1.0d0-sss)
12502 end subroutine ebp_long
12503 !-----------------------------------------------------------------------------
12504 subroutine ebp_short(evdw)
12506 ! This subroutine calculates the interaction energy of nonbonded side chains
12507 ! assuming the Berne-Pechukas potential of interaction.
12510 ! implicit real*8 (a-h,o-z)
12511 ! include 'DIMENSIONS'
12512 ! include 'COMMON.GEO'
12513 ! include 'COMMON.VAR'
12514 ! include 'COMMON.LOCAL'
12515 ! include 'COMMON.CHAIN'
12516 ! include 'COMMON.DERIV'
12517 ! include 'COMMON.NAMES'
12518 ! include 'COMMON.INTERACT'
12519 ! include 'COMMON.IOUNITS'
12520 ! include 'COMMON.CALC'
12522 !el integer :: icall
12523 !el common /srutu/ icall
12524 ! double precision rrsave(maxdim)
12526 !el local variables
12527 integer :: iint,itypi,itypi1,itypj
12528 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
12529 real(kind=8) :: sss,e1,e2,evdw
12531 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12533 ! if (icall.eq.0) then
12539 do i=iatsc_s,iatsc_e
12541 if (itypi.eq.ntyp1) cycle
12546 dxi=dc_norm(1,nres+i)
12547 dyi=dc_norm(2,nres+i)
12548 dzi=dc_norm(3,nres+i)
12549 ! dsci_inv=dsc_inv(itypi)
12550 dsci_inv=vbld_inv(i+nres)
12552 ! Calculate SC interaction energy.
12554 do iint=1,nint_gr(i)
12555 do j=istart(i,iint),iend(i,iint)
12558 if (itypj.eq.ntyp1) cycle
12559 ! dscj_inv=dsc_inv(itypj)
12560 dscj_inv=vbld_inv(j+nres)
12561 chi1=chi(itypi,itypj)
12562 chi2=chi(itypj,itypi)
12569 alf12=0.5D0*(alf1+alf2)
12573 dxj=dc_norm(1,nres+j)
12574 dyj=dc_norm(2,nres+j)
12575 dzj=dc_norm(3,nres+j)
12576 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12578 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12580 if (sss.gt.0.0d0) then
12582 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12584 ! Calculate whole angle-dependent part of epsilon and contributions
12585 ! to its derivatives
12586 fac=(rrij*sigsq)**expon2
12587 e1=fac*fac*aa_aq(itypi,itypj)
12588 e2=fac*bb_aq(itypi,itypj)
12589 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12590 eps2der=evdwij*eps3rt
12591 eps3der=evdwij*eps2rt
12592 evdwij=evdwij*eps2rt*eps3rt
12593 evdw=evdw+evdwij*sss
12595 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12596 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12597 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12598 !d & restyp(itypi),i,restyp(itypj),j,
12599 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12600 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12601 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12604 ! Calculate gradient components.
12605 e1=e1*eps1*eps2rt**2*eps3rt**2
12606 fac=-expon*(e1+evdwij)
12609 ! Calculate radial part of the gradient
12613 ! Calculate the angular part of the gradient and sum add the contributions
12614 ! to the appropriate components of the Cartesian gradient.
12615 call sc_grad_scale(sss)
12622 end subroutine ebp_short
12623 !-----------------------------------------------------------------------------
12624 subroutine egb_long(evdw)
12626 ! This subroutine calculates the interaction energy of nonbonded side chains
12627 ! assuming the Gay-Berne potential of interaction.
12630 ! implicit real*8 (a-h,o-z)
12631 ! include 'DIMENSIONS'
12632 ! include 'COMMON.GEO'
12633 ! include 'COMMON.VAR'
12634 ! include 'COMMON.LOCAL'
12635 ! include 'COMMON.CHAIN'
12636 ! include 'COMMON.DERIV'
12637 ! include 'COMMON.NAMES'
12638 ! include 'COMMON.INTERACT'
12639 ! include 'COMMON.IOUNITS'
12640 ! include 'COMMON.CALC'
12641 ! include 'COMMON.CONTROL'
12643 !el local variables
12644 integer :: iint,itypi,itypi1,itypj,subchap
12645 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
12646 real(kind=8) :: sss,e1,e2,evdw,sss_grad
12647 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
12648 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
12649 ssgradlipi,ssgradlipj
12653 !cccc energy_dec=.false.
12654 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
12657 ! if (icall.eq.0) lprn=.false.
12659 do i=iatsc_s,iatsc_e
12661 if (itypi.eq.ntyp1) cycle
12666 xi=mod(xi,boxxsize)
12667 if (xi.lt.0) xi=xi+boxxsize
12668 yi=mod(yi,boxysize)
12669 if (yi.lt.0) yi=yi+boxysize
12670 zi=mod(zi,boxzsize)
12671 if (zi.lt.0) zi=zi+boxzsize
12672 if ((zi.gt.bordlipbot) &
12673 .and.(zi.lt.bordliptop)) then
12674 !C the energy transfer exist
12675 if (zi.lt.buflipbot) then
12676 !C what fraction I am in
12678 ((zi-bordlipbot)/lipbufthick)
12679 !C lipbufthick is thickenes of lipid buffore
12680 sslipi=sscalelip(fracinbuf)
12681 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
12682 elseif (zi.gt.bufliptop) then
12683 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
12684 sslipi=sscalelip(fracinbuf)
12685 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
12695 dxi=dc_norm(1,nres+i)
12696 dyi=dc_norm(2,nres+i)
12697 dzi=dc_norm(3,nres+i)
12698 ! dsci_inv=dsc_inv(itypi)
12699 dsci_inv=vbld_inv(i+nres)
12700 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
12701 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
12703 ! Calculate SC interaction energy.
12705 do iint=1,nint_gr(i)
12706 do j=istart(i,iint),iend(i,iint)
12707 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
12708 call dyn_ssbond_ene(i,j,evdwij)
12710 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
12711 'evdw',i,j,evdwij,' ss'
12712 ! if (energy_dec) write (iout,*) &
12713 ! 'evdw',i,j,evdwij,' ss'
12717 if (itypj.eq.ntyp1) cycle
12718 ! dscj_inv=dsc_inv(itypj)
12719 dscj_inv=vbld_inv(j+nres)
12720 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
12721 ! & 1.0d0/vbld(j+nres)
12722 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
12723 sig0ij=sigma(itypi,itypj)
12724 chi1=chi(itypi,itypj)
12725 chi2=chi(itypj,itypi)
12732 alf12=0.5D0*(alf1+alf2)
12736 ! Searching for nearest neighbour
12737 xj=mod(xj,boxxsize)
12738 if (xj.lt.0) xj=xj+boxxsize
12739 yj=mod(yj,boxysize)
12740 if (yj.lt.0) yj=yj+boxysize
12741 zj=mod(zj,boxzsize)
12742 if (zj.lt.0) zj=zj+boxzsize
12743 if ((zj.gt.bordlipbot) &
12744 .and.(zj.lt.bordliptop)) then
12745 !C the energy transfer exist
12746 if (zj.lt.buflipbot) then
12747 !C what fraction I am in
12749 ((zj-bordlipbot)/lipbufthick)
12750 !C lipbufthick is thickenes of lipid buffore
12751 sslipj=sscalelip(fracinbuf)
12752 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
12753 elseif (zj.gt.bufliptop) then
12754 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
12755 sslipj=sscalelip(fracinbuf)
12756 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
12765 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
12766 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
12767 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
12768 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
12770 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
12778 xj=xj_safe+xshift*boxxsize
12779 yj=yj_safe+yshift*boxysize
12780 zj=zj_safe+zshift*boxzsize
12781 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
12782 if(dist_temp.lt.dist_init) then
12783 dist_init=dist_temp
12792 if (subchap.eq.1) then
12802 dxj=dc_norm(1,nres+j)
12803 dyj=dc_norm(2,nres+j)
12804 dzj=dc_norm(3,nres+j)
12805 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12807 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12808 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
12809 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
12810 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
12811 if (sss_ele_cut.le.0.0) cycle
12812 if (sss.lt.1.0d0) then
12814 ! Calculate angle-dependent terms of energy and contributions to their
12818 sig=sig0ij*dsqrt(sigsq)
12819 rij_shift=1.0D0/rij-sig+sig0ij
12820 ! for diagnostics; uncomment
12821 ! rij_shift=1.2*sig0ij
12822 ! I hate to put IF's in the loops, but here don't have another choice!!!!
12823 if (rij_shift.le.0.0D0) then
12825 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
12826 !d & restyp(itypi),i,restyp(itypj),j,
12827 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
12831 !---------------------------------------------------------------
12832 rij_shift=1.0D0/rij_shift
12833 fac=rij_shift**expon
12836 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12837 eps2der=evdwij*eps3rt
12838 eps3der=evdwij*eps2rt
12839 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
12840 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
12841 evdwij=evdwij*eps2rt*eps3rt
12842 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
12844 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12845 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12846 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
12847 restyp(itypi),i,restyp(itypj),j,&
12848 epsi,sigm,chi1,chi2,chip1,chip2,&
12849 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
12850 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
12854 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
12856 ! if (energy_dec) write (iout,*) &
12857 ! 'evdw',i,j,evdwij,"egb_long"
12859 ! Calculate gradient components.
12860 e1=e1*eps1*eps2rt**2*eps3rt**2
12861 fac=-expon*(e1+evdwij)*rij_shift
12864 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
12865 /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
12866 /sigmaii(itypi,itypj))
12868 ! Calculate the radial part of the gradient
12872 ! Calculate angular part of the gradient.
12873 call sc_grad_scale(1.0d0-sss)
12879 ! write (iout,*) "Number of loop steps in EGB:",ind
12880 !ccc energy_dec=.false.
12882 end subroutine egb_long
12883 !-----------------------------------------------------------------------------
12884 subroutine egb_short(evdw)
12886 ! This subroutine calculates the interaction energy of nonbonded side chains
12887 ! assuming the Gay-Berne potential of interaction.
12890 ! implicit real*8 (a-h,o-z)
12891 ! include 'DIMENSIONS'
12892 ! include 'COMMON.GEO'
12893 ! include 'COMMON.VAR'
12894 ! include 'COMMON.LOCAL'
12895 ! include 'COMMON.CHAIN'
12896 ! include 'COMMON.DERIV'
12897 ! include 'COMMON.NAMES'
12898 ! include 'COMMON.INTERACT'
12899 ! include 'COMMON.IOUNITS'
12900 ! include 'COMMON.CALC'
12901 ! include 'COMMON.CONTROL'
12903 !el local variables
12904 integer :: iint,itypi,itypi1,itypj,subchap
12905 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
12906 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
12907 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
12908 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
12909 ssgradlipi,ssgradlipj
12911 !cccc energy_dec=.false.
12912 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
12915 ! if (icall.eq.0) lprn=.false.
12917 do i=iatsc_s,iatsc_e
12919 if (itypi.eq.ntyp1) cycle
12924 xi=mod(xi,boxxsize)
12925 if (xi.lt.0) xi=xi+boxxsize
12926 yi=mod(yi,boxysize)
12927 if (yi.lt.0) yi=yi+boxysize
12928 zi=mod(zi,boxzsize)
12929 if (zi.lt.0) zi=zi+boxzsize
12930 if ((zi.gt.bordlipbot) &
12931 .and.(zi.lt.bordliptop)) then
12932 !C the energy transfer exist
12933 if (zi.lt.buflipbot) then
12934 !C what fraction I am in
12936 ((zi-bordlipbot)/lipbufthick)
12937 !C lipbufthick is thickenes of lipid buffore
12938 sslipi=sscalelip(fracinbuf)
12939 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
12940 elseif (zi.gt.bufliptop) then
12941 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
12942 sslipi=sscalelip(fracinbuf)
12943 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
12953 dxi=dc_norm(1,nres+i)
12954 dyi=dc_norm(2,nres+i)
12955 dzi=dc_norm(3,nres+i)
12956 ! dsci_inv=dsc_inv(itypi)
12957 dsci_inv=vbld_inv(i+nres)
12959 dxi=dc_norm(1,nres+i)
12960 dyi=dc_norm(2,nres+i)
12961 dzi=dc_norm(3,nres+i)
12962 ! dsci_inv=dsc_inv(itypi)
12963 dsci_inv=vbld_inv(i+nres)
12964 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
12965 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
12967 ! Calculate SC interaction energy.
12969 do iint=1,nint_gr(i)
12970 do j=istart(i,iint),iend(i,iint)
12971 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
12972 call dyn_ssbond_ene(i,j,evdwij)
12974 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
12975 'evdw',i,j,evdwij,' ss'
12976 ! if (energy_dec) write (iout,*) &
12977 ! 'evdw',i,j,evdwij,' ss'
12981 if (itypj.eq.ntyp1) cycle
12982 ! dscj_inv=dsc_inv(itypj)
12983 dscj_inv=vbld_inv(j+nres)
12984 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
12985 ! & 1.0d0/vbld(j+nres)
12986 ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
12987 sig0ij=sigma(itypi,itypj)
12988 chi1=chi(itypi,itypj)
12989 chi2=chi(itypj,itypi)
12996 alf12=0.5D0*(alf1+alf2)
12997 ! xj=c(1,nres+j)-xi
12998 ! yj=c(2,nres+j)-yi
12999 ! zj=c(3,nres+j)-zi
13003 ! Searching for nearest neighbour
13004 xj=mod(xj,boxxsize)
13005 if (xj.lt.0) xj=xj+boxxsize
13006 yj=mod(yj,boxysize)
13007 if (yj.lt.0) yj=yj+boxysize
13008 zj=mod(zj,boxzsize)
13009 if (zj.lt.0) zj=zj+boxzsize
13010 if ((zj.gt.bordlipbot) &
13011 .and.(zj.lt.bordliptop)) then
13012 !C the energy transfer exist
13013 if (zj.lt.buflipbot) then
13014 !C what fraction I am in
13016 ((zj-bordlipbot)/lipbufthick)
13017 !C lipbufthick is thickenes of lipid buffore
13018 sslipj=sscalelip(fracinbuf)
13019 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13020 elseif (zj.gt.bufliptop) then
13021 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13022 sslipj=sscalelip(fracinbuf)
13023 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13032 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13033 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13034 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13035 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13037 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13046 xj=xj_safe+xshift*boxxsize
13047 yj=yj_safe+yshift*boxysize
13048 zj=zj_safe+zshift*boxzsize
13049 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13050 if(dist_temp.lt.dist_init) then
13051 dist_init=dist_temp
13060 if (subchap.eq.1) then
13070 dxj=dc_norm(1,nres+j)
13071 dyj=dc_norm(2,nres+j)
13072 dzj=dc_norm(3,nres+j)
13073 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13075 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13076 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13077 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13078 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13079 if (sss_ele_cut.le.0.0) cycle
13081 if (sss.gt.0.0d0) then
13083 ! Calculate angle-dependent terms of energy and contributions to their
13087 sig=sig0ij*dsqrt(sigsq)
13088 rij_shift=1.0D0/rij-sig+sig0ij
13089 ! for diagnostics; uncomment
13090 ! rij_shift=1.2*sig0ij
13091 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13092 if (rij_shift.le.0.0D0) then
13094 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13095 !d & restyp(itypi),i,restyp(itypj),j,
13096 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13100 !---------------------------------------------------------------
13101 rij_shift=1.0D0/rij_shift
13102 fac=rij_shift**expon
13105 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13106 eps2der=evdwij*eps3rt
13107 eps3der=evdwij*eps2rt
13108 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13109 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13110 evdwij=evdwij*eps2rt*eps3rt
13111 evdw=evdw+evdwij*sss*sss_ele_cut
13113 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13114 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13115 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13116 restyp(itypi),i,restyp(itypj),j,&
13117 epsi,sigm,chi1,chi2,chip1,chip2,&
13118 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13119 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13123 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13125 ! if (energy_dec) write (iout,*) &
13126 ! 'evdw',i,j,evdwij,"egb_short"
13128 ! Calculate gradient components.
13129 e1=e1*eps1*eps2rt**2*eps3rt**2
13130 fac=-expon*(e1+evdwij)*rij_shift
13133 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13134 /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
13135 /sigmaii(itypi,itypj))
13138 ! Calculate the radial part of the gradient
13142 ! Calculate angular part of the gradient.
13143 call sc_grad_scale(sss)
13149 ! write (iout,*) "Number of loop steps in EGB:",ind
13150 !ccc energy_dec=.false.
13152 end subroutine egb_short
13153 !-----------------------------------------------------------------------------
13154 subroutine egbv_long(evdw)
13156 ! This subroutine calculates the interaction energy of nonbonded side chains
13157 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13160 ! implicit real*8 (a-h,o-z)
13161 ! include 'DIMENSIONS'
13162 ! include 'COMMON.GEO'
13163 ! include 'COMMON.VAR'
13164 ! include 'COMMON.LOCAL'
13165 ! include 'COMMON.CHAIN'
13166 ! include 'COMMON.DERIV'
13167 ! include 'COMMON.NAMES'
13168 ! include 'COMMON.INTERACT'
13169 ! include 'COMMON.IOUNITS'
13170 ! include 'COMMON.CALC'
13172 !el integer :: icall
13173 !el common /srutu/ icall
13175 !el local variables
13176 integer :: iint,itypi,itypi1,itypj
13177 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
13178 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
13180 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13183 ! if (icall.eq.0) lprn=.true.
13185 do i=iatsc_s,iatsc_e
13187 if (itypi.eq.ntyp1) cycle
13192 dxi=dc_norm(1,nres+i)
13193 dyi=dc_norm(2,nres+i)
13194 dzi=dc_norm(3,nres+i)
13195 ! dsci_inv=dsc_inv(itypi)
13196 dsci_inv=vbld_inv(i+nres)
13198 ! Calculate SC interaction energy.
13200 do iint=1,nint_gr(i)
13201 do j=istart(i,iint),iend(i,iint)
13204 if (itypj.eq.ntyp1) cycle
13205 ! dscj_inv=dsc_inv(itypj)
13206 dscj_inv=vbld_inv(j+nres)
13207 sig0ij=sigma(itypi,itypj)
13208 r0ij=r0(itypi,itypj)
13209 chi1=chi(itypi,itypj)
13210 chi2=chi(itypj,itypi)
13217 alf12=0.5D0*(alf1+alf2)
13221 dxj=dc_norm(1,nres+j)
13222 dyj=dc_norm(2,nres+j)
13223 dzj=dc_norm(3,nres+j)
13224 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13227 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13229 if (sss.lt.1.0d0) then
13231 ! Calculate angle-dependent terms of energy and contributions to their
13235 sig=sig0ij*dsqrt(sigsq)
13236 rij_shift=1.0D0/rij-sig+r0ij
13237 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13238 if (rij_shift.le.0.0D0) then
13243 !---------------------------------------------------------------
13244 rij_shift=1.0D0/rij_shift
13245 fac=rij_shift**expon
13246 e1=fac*fac*aa_aq(itypi,itypj)
13247 e2=fac*bb_aq(itypi,itypj)
13248 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13249 eps2der=evdwij*eps3rt
13250 eps3der=evdwij*eps2rt
13251 fac_augm=rrij**expon
13252 e_augm=augm(itypi,itypj)*fac_augm
13253 evdwij=evdwij*eps2rt*eps3rt
13254 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
13256 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13257 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13258 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13259 restyp(itypi),i,restyp(itypj),j,&
13260 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13261 chi1,chi2,chip1,chip2,&
13262 eps1,eps2rt**2,eps3rt**2,&
13263 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13266 ! Calculate gradient components.
13267 e1=e1*eps1*eps2rt**2*eps3rt**2
13268 fac=-expon*(e1+evdwij)*rij_shift
13270 fac=rij*fac-2*expon*rrij*e_augm
13271 ! Calculate the radial part of the gradient
13275 ! Calculate angular part of the gradient.
13276 call sc_grad_scale(1.0d0-sss)
13281 end subroutine egbv_long
13282 !-----------------------------------------------------------------------------
13283 subroutine egbv_short(evdw)
13285 ! This subroutine calculates the interaction energy of nonbonded side chains
13286 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13289 ! implicit real*8 (a-h,o-z)
13290 ! include 'DIMENSIONS'
13291 ! include 'COMMON.GEO'
13292 ! include 'COMMON.VAR'
13293 ! include 'COMMON.LOCAL'
13294 ! include 'COMMON.CHAIN'
13295 ! include 'COMMON.DERIV'
13296 ! include 'COMMON.NAMES'
13297 ! include 'COMMON.INTERACT'
13298 ! include 'COMMON.IOUNITS'
13299 ! include 'COMMON.CALC'
13301 !el integer :: icall
13302 !el common /srutu/ icall
13304 !el local variables
13305 integer :: iint,itypi,itypi1,itypj
13306 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
13307 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
13309 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13312 ! if (icall.eq.0) lprn=.true.
13314 do i=iatsc_s,iatsc_e
13316 if (itypi.eq.ntyp1) cycle
13321 dxi=dc_norm(1,nres+i)
13322 dyi=dc_norm(2,nres+i)
13323 dzi=dc_norm(3,nres+i)
13324 ! dsci_inv=dsc_inv(itypi)
13325 dsci_inv=vbld_inv(i+nres)
13327 ! Calculate SC interaction energy.
13329 do iint=1,nint_gr(i)
13330 do j=istart(i,iint),iend(i,iint)
13333 if (itypj.eq.ntyp1) cycle
13334 ! dscj_inv=dsc_inv(itypj)
13335 dscj_inv=vbld_inv(j+nres)
13336 sig0ij=sigma(itypi,itypj)
13337 r0ij=r0(itypi,itypj)
13338 chi1=chi(itypi,itypj)
13339 chi2=chi(itypj,itypi)
13346 alf12=0.5D0*(alf1+alf2)
13350 dxj=dc_norm(1,nres+j)
13351 dyj=dc_norm(2,nres+j)
13352 dzj=dc_norm(3,nres+j)
13353 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13356 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13358 if (sss.gt.0.0d0) then
13360 ! Calculate angle-dependent terms of energy and contributions to their
13364 sig=sig0ij*dsqrt(sigsq)
13365 rij_shift=1.0D0/rij-sig+r0ij
13366 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13367 if (rij_shift.le.0.0D0) then
13372 !---------------------------------------------------------------
13373 rij_shift=1.0D0/rij_shift
13374 fac=rij_shift**expon
13375 e1=fac*fac*aa_aq(itypi,itypj)
13376 e2=fac*bb_aq(itypi,itypj)
13377 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13378 eps2der=evdwij*eps3rt
13379 eps3der=evdwij*eps2rt
13380 fac_augm=rrij**expon
13381 e_augm=augm(itypi,itypj)*fac_augm
13382 evdwij=evdwij*eps2rt*eps3rt
13383 evdw=evdw+(evdwij+e_augm)*sss
13385 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13386 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13387 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13388 restyp(itypi),i,restyp(itypj),j,&
13389 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13390 chi1,chi2,chip1,chip2,&
13391 eps1,eps2rt**2,eps3rt**2,&
13392 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13395 ! Calculate gradient components.
13396 e1=e1*eps1*eps2rt**2*eps3rt**2
13397 fac=-expon*(e1+evdwij)*rij_shift
13399 fac=rij*fac-2*expon*rrij*e_augm
13400 ! Calculate the radial part of the gradient
13404 ! Calculate angular part of the gradient.
13405 call sc_grad_scale(sss)
13410 end subroutine egbv_short
13411 !-----------------------------------------------------------------------------
13412 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13414 ! This subroutine calculates the average interaction energy and its gradient
13415 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
13416 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
13417 ! The potential depends both on the distance of peptide-group centers and on
13418 ! the orientation of the CA-CA virtual bonds.
13420 ! implicit real*8 (a-h,o-z)
13426 ! include 'DIMENSIONS'
13427 ! include 'COMMON.CONTROL'
13428 ! include 'COMMON.SETUP'
13429 ! include 'COMMON.IOUNITS'
13430 ! include 'COMMON.GEO'
13431 ! include 'COMMON.VAR'
13432 ! include 'COMMON.LOCAL'
13433 ! include 'COMMON.CHAIN'
13434 ! include 'COMMON.DERIV'
13435 ! include 'COMMON.INTERACT'
13436 ! include 'COMMON.CONTACTS'
13437 ! include 'COMMON.TORSION'
13438 ! include 'COMMON.VECTORS'
13439 ! include 'COMMON.FFIELD'
13440 ! include 'COMMON.TIME1'
13441 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
13442 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
13443 real(kind=8),dimension(2,2) :: acipa !el,a_temp
13444 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
13445 real(kind=8),dimension(4) :: muij
13446 !el integer :: num_conti,j1,j2
13447 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
13448 !el dz_normi,xmedi,ymedi,zmedi
13449 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
13450 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13451 !el num_conti,j1,j2
13452 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13454 real(kind=8) :: scal_el=1.0d0
13456 real(kind=8) :: scal_el=0.5d0
13459 ! 13-go grudnia roku pamietnego...
13460 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
13461 0.0d0,1.0d0,0.0d0,&
13462 0.0d0,0.0d0,1.0d0/),shape(unmat))
13463 !el local variables
13465 real(kind=8) :: fac
13466 real(kind=8) :: dxj,dyj,dzj
13467 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
13469 ! allocate(num_cont_hb(nres)) !(maxres)
13470 !d write(iout,*) 'In EELEC'
13472 !d write(iout,*) 'Type',i
13473 !d write(iout,*) 'B1',B1(:,i)
13474 !d write(iout,*) 'B2',B2(:,i)
13475 !d write(iout,*) 'CC',CC(:,:,i)
13476 !d write(iout,*) 'DD',DD(:,:,i)
13477 !d write(iout,*) 'EE',EE(:,:,i)
13479 !d call check_vecgrad
13481 if (icheckgrad.eq.1) then
13483 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
13485 dc_norm(k,i)=dc(k,i)*fac
13487 ! write (iout,*) 'i',i,' fac',fac
13490 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
13491 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
13492 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
13493 ! call vec_and_deriv
13497 ! print *, "before set matrices"
13499 ! print *,"after set martices"
13501 time_mat=time_mat+MPI_Wtime()-time01
13505 !d write (iout,*) 'i=',i
13507 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
13510 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
13511 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
13524 !d print '(a)','Enter EELEC'
13525 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
13526 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
13527 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
13529 gel_loc_loc(i)=0.0d0
13534 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
13536 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
13538 do i=iturn3_start,iturn3_end
13539 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1 &
13540 .or. itype(i+2).eq.ntyp1 .or. itype(i+3).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
13557 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
13558 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
13559 num_cont_hb(i)=num_conti
13561 do i=iturn4_start,iturn4_end
13562 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 &
13563 .or. itype(i+3).eq.ntyp1 &
13564 .or. itype(i+4).eq.ntyp1) cycle
13568 dx_normi=dc_norm(1,i)
13569 dy_normi=dc_norm(2,i)
13570 dz_normi=dc_norm(3,i)
13571 xmedi=c(1,i)+0.5d0*dxi
13572 ymedi=c(2,i)+0.5d0*dyi
13573 zmedi=c(3,i)+0.5d0*dzi
13574 xmedi=dmod(xmedi,boxxsize)
13575 if (xmedi.lt.0) xmedi=xmedi+boxxsize
13576 ymedi=dmod(ymedi,boxysize)
13577 if (ymedi.lt.0) ymedi=ymedi+boxysize
13578 zmedi=dmod(zmedi,boxzsize)
13579 if (zmedi.lt.0) zmedi=zmedi+boxzsize
13580 num_conti=num_cont_hb(i)
13581 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
13582 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
13583 call eturn4(i,eello_turn4)
13584 num_cont_hb(i)=num_conti
13587 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
13589 do i=iatel_s,iatel_e
13590 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
13594 dx_normi=dc_norm(1,i)
13595 dy_normi=dc_norm(2,i)
13596 dz_normi=dc_norm(3,i)
13597 xmedi=c(1,i)+0.5d0*dxi
13598 ymedi=c(2,i)+0.5d0*dyi
13599 zmedi=c(3,i)+0.5d0*dzi
13600 xmedi=dmod(xmedi,boxxsize)
13601 if (xmedi.lt.0) xmedi=xmedi+boxxsize
13602 ymedi=dmod(ymedi,boxysize)
13603 if (ymedi.lt.0) ymedi=ymedi+boxysize
13604 zmedi=dmod(zmedi,boxzsize)
13605 if (zmedi.lt.0) zmedi=zmedi+boxzsize
13606 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
13607 num_conti=num_cont_hb(i)
13608 do j=ielstart(i),ielend(i)
13609 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
13610 call eelecij_scale(i,j,ees,evdw1,eel_loc)
13612 num_cont_hb(i)=num_conti
13614 ! write (iout,*) "Number of loop steps in EELEC:",ind
13616 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
13617 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
13619 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
13620 !cc eel_loc=eel_loc+eello_turn3
13621 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
13623 end subroutine eelec_scale
13624 !-----------------------------------------------------------------------------
13625 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
13626 ! implicit real*8 (a-h,o-z)
13629 ! include 'DIMENSIONS'
13633 ! include 'COMMON.CONTROL'
13634 ! include 'COMMON.IOUNITS'
13635 ! include 'COMMON.GEO'
13636 ! include 'COMMON.VAR'
13637 ! include 'COMMON.LOCAL'
13638 ! include 'COMMON.CHAIN'
13639 ! include 'COMMON.DERIV'
13640 ! include 'COMMON.INTERACT'
13641 ! include 'COMMON.CONTACTS'
13642 ! include 'COMMON.TORSION'
13643 ! include 'COMMON.VECTORS'
13644 ! include 'COMMON.FFIELD'
13645 ! include 'COMMON.TIME1'
13646 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
13647 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
13648 real(kind=8),dimension(2,2) :: acipa !el,a_temp
13649 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
13650 real(kind=8),dimension(4) :: muij
13651 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13652 dist_temp, dist_init,sss_grad
13653 integer xshift,yshift,zshift
13655 !el integer :: num_conti,j1,j2
13656 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
13657 !el dz_normi,xmedi,ymedi,zmedi
13658 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
13659 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13660 !el num_conti,j1,j2
13661 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13663 real(kind=8) :: scal_el=1.0d0
13665 real(kind=8) :: scal_el=0.5d0
13668 ! 13-go grudnia roku pamietnego...
13669 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
13670 0.0d0,1.0d0,0.0d0,&
13671 0.0d0,0.0d0,1.0d0/),shape(unmat))
13672 !el local variables
13673 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
13674 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
13675 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
13676 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
13677 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
13678 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
13679 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
13680 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
13681 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
13682 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
13683 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
13684 ecosam,ecosbm,ecosgm,ghalf,time00
13685 ! integer :: maxconts
13686 ! maxconts = nres/4
13687 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13688 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13689 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13690 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13691 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13692 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13693 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13694 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13695 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
13696 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
13697 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
13698 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
13699 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
13701 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
13702 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
13707 !d write (iout,*) "eelecij",i,j
13711 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
13712 aaa=app(iteli,itelj)
13713 bbb=bpp(iteli,itelj)
13714 ael6i=ael6(iteli,itelj)
13715 ael3i=ael3(iteli,itelj)
13719 dx_normj=dc_norm(1,j)
13720 dy_normj=dc_norm(2,j)
13721 dz_normj=dc_norm(3,j)
13722 ! xj=c(1,j)+0.5D0*dxj-xmedi
13723 ! yj=c(2,j)+0.5D0*dyj-ymedi
13724 ! zj=c(3,j)+0.5D0*dzj-zmedi
13725 xj=c(1,j)+0.5D0*dxj
13726 yj=c(2,j)+0.5D0*dyj
13727 zj=c(3,j)+0.5D0*dzj
13728 xj=mod(xj,boxxsize)
13729 if (xj.lt.0) xj=xj+boxxsize
13730 yj=mod(yj,boxysize)
13731 if (yj.lt.0) yj=yj+boxysize
13732 zj=mod(zj,boxzsize)
13733 if (zj.lt.0) zj=zj+boxzsize
13735 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
13742 xj=xj_safe+xshift*boxxsize
13743 yj=yj_safe+yshift*boxysize
13744 zj=zj_safe+zshift*boxzsize
13745 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
13746 if(dist_temp.lt.dist_init) then
13747 dist_init=dist_temp
13756 if (isubchap.eq.1) then
13767 rij=xj*xj+yj*yj+zj*zj
13771 ! For extracting the short-range part of Evdwpp
13772 sss=sscale(rij/rpp(iteli,itelj))
13773 sss_ele_cut=sscale_ele(rij)
13774 sss_ele_grad=sscagrad_ele(rij)
13775 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
13776 ! sss_ele_cut=1.0d0
13777 ! sss_ele_grad=0.0d0
13778 if (sss_ele_cut.le.0.0) go to 128
13782 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
13783 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
13784 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
13785 fac=cosa-3.0D0*cosb*cosg
13787 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
13788 if (j.eq.i+2) ev1=scal_el*ev1
13793 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
13796 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
13797 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
13798 ees=ees+eesij*sss_ele_cut
13799 evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
13800 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
13801 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
13802 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
13803 !d & xmedi,ymedi,zmedi,xj,yj,zj
13805 if (energy_dec) then
13806 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
13807 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
13811 ! Calculate contributions to the Cartesian gradient.
13814 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
13815 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
13821 ! Radial derivatives. First process both termini of the fragment (i,j)
13823 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
13824 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
13825 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
13827 ! ghalf=0.5D0*ggg(k)
13828 ! gelc(k,i)=gelc(k,i)+ghalf
13829 ! gelc(k,j)=gelc(k,j)+ghalf
13831 ! 9/28/08 AL Gradient compotents will be summed only at the end
13833 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
13834 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
13837 ! Loop over residues i+1 thru j-1.
13841 !grad gelc(l,k)=gelc(l,k)+ggg(l)
13844 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
13845 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
13846 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
13847 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
13848 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
13849 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
13851 ! ghalf=0.5D0*ggg(k)
13852 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
13853 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
13855 ! 9/28/08 AL Gradient compotents will be summed only at the end
13857 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
13858 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
13861 ! Loop over residues i+1 thru j-1.
13865 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
13869 facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
13870 facel=(el1+eesij)*sss_ele_cut
13872 fac=-3*rrmij*(facvdw+facvdw+facel)
13877 ! Radial derivatives. First process both termini of the fragment (i,j)
13883 ! ghalf=0.5D0*ggg(k)
13884 ! gelc(k,i)=gelc(k,i)+ghalf
13885 ! gelc(k,j)=gelc(k,j)+ghalf
13887 ! 9/28/08 AL Gradient compotents will be summed only at the end
13889 gelc_long(k,j)=gelc(k,j)+ggg(k)
13890 gelc_long(k,i)=gelc(k,i)-ggg(k)
13893 ! Loop over residues i+1 thru j-1.
13897 !grad gelc(l,k)=gelc(l,k)+ggg(l)
13900 ! 9/28/08 AL Gradient compotents will be summed only at the end
13905 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
13906 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
13912 ecosa=2.0D0*fac3*fac1+fac4
13915 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
13916 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
13918 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
13919 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
13921 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
13922 !d & (dcosg(k),k=1,3)
13924 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
13927 ! ghalf=0.5D0*ggg(k)
13928 ! gelc(k,i)=gelc(k,i)+ghalf
13929 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
13930 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
13931 ! gelc(k,j)=gelc(k,j)+ghalf
13932 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
13933 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
13937 !grad gelc(l,k)=gelc(l,k)+ggg(l)
13941 gelc(k,i)=gelc(k,i) &
13942 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
13943 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
13945 gelc(k,j)=gelc(k,j) &
13946 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
13947 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
13949 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
13950 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
13952 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
13953 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
13954 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
13956 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
13957 ! energy of a peptide unit is assumed in the form of a second-order
13958 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
13959 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
13960 ! are computed for EVERY pair of non-contiguous peptide groups.
13962 if (j.lt.nres-1) then
13973 muij(kkk)=mu(k,i)*mu(l,j)
13976 !d write (iout,*) 'EELEC: i',i,' j',j
13977 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
13978 !d write(iout,*) 'muij',muij
13979 ury=scalar(uy(1,i),erij)
13980 urz=scalar(uz(1,i),erij)
13981 vry=scalar(uy(1,j),erij)
13982 vrz=scalar(uz(1,j),erij)
13983 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
13984 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
13985 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
13986 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
13987 fac=dsqrt(-ael6i)*r3ij
13992 !d write (iout,'(4i5,4f10.5)')
13993 !d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
13994 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
13995 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
13996 !d & uy(:,j),uz(:,j)
13997 !d write (iout,'(4f10.5)')
13998 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
13999 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
14000 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
14001 !d write (iout,'(9f10.5/)')
14002 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
14003 ! Derivatives of the elements of A in virtual-bond vectors
14004 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
14006 uryg(k,1)=scalar(erder(1,k),uy(1,i))
14007 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
14008 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
14009 urzg(k,1)=scalar(erder(1,k),uz(1,i))
14010 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
14011 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
14012 vryg(k,1)=scalar(erder(1,k),uy(1,j))
14013 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
14014 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
14015 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
14016 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
14017 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
14019 ! Compute radial contributions to the gradient
14037 ! Add the contributions coming from er
14040 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
14041 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
14042 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
14043 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
14046 ! Derivatives in DC(i)
14047 !grad ghalf1=0.5d0*agg(k,1)
14048 !grad ghalf2=0.5d0*agg(k,2)
14049 !grad ghalf3=0.5d0*agg(k,3)
14050 !grad ghalf4=0.5d0*agg(k,4)
14051 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
14052 -3.0d0*uryg(k,2)*vry)!+ghalf1
14053 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
14054 -3.0d0*uryg(k,2)*vrz)!+ghalf2
14055 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
14056 -3.0d0*urzg(k,2)*vry)!+ghalf3
14057 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
14058 -3.0d0*urzg(k,2)*vrz)!+ghalf4
14059 ! Derivatives in DC(i+1)
14060 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
14061 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
14062 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
14063 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
14064 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
14065 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
14066 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
14067 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
14068 ! Derivatives in DC(j)
14069 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
14070 -3.0d0*vryg(k,2)*ury)!+ghalf1
14071 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
14072 -3.0d0*vrzg(k,2)*ury)!+ghalf2
14073 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
14074 -3.0d0*vryg(k,2)*urz)!+ghalf3
14075 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
14076 -3.0d0*vrzg(k,2)*urz)!+ghalf4
14077 ! Derivatives in DC(j+1) or DC(nres-1)
14078 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
14079 -3.0d0*vryg(k,3)*ury)
14080 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
14081 -3.0d0*vrzg(k,3)*ury)
14082 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
14083 -3.0d0*vryg(k,3)*urz)
14084 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
14085 -3.0d0*vrzg(k,3)*urz)
14086 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
14088 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
14101 aggi(k,l)=-aggi(k,l)
14102 aggi1(k,l)=-aggi1(k,l)
14103 aggj(k,l)=-aggj(k,l)
14104 aggj1(k,l)=-aggj1(k,l)
14107 if (j.lt.nres-1) then
14113 aggi(k,l)=-aggi(k,l)
14114 aggi1(k,l)=-aggi1(k,l)
14115 aggj(k,l)=-aggj(k,l)
14116 aggj1(k,l)=-aggj1(k,l)
14127 aggi(k,l)=-aggi(k,l)
14128 aggi1(k,l)=-aggi1(k,l)
14129 aggj(k,l)=-aggj(k,l)
14130 aggj1(k,l)=-aggj1(k,l)
14135 IF (wel_loc.gt.0.0d0) THEN
14136 ! Contribution to the local-electrostatic energy coming from the i-j pair
14137 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
14139 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
14141 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14142 'eelloc',i,j,eel_loc_ij
14143 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
14145 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
14146 ! Partial derivatives in virtual-bond dihedral angles gamma
14148 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
14149 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
14150 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
14152 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
14153 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
14154 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
14160 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
14162 ggg(l)=(agg(l,1)*muij(1)+ &
14163 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
14165 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
14167 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
14168 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
14169 !grad ghalf=0.5d0*ggg(l)
14170 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
14171 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
14175 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
14178 ! Remaining derivatives of eello
14180 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
14181 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
14184 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
14185 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
14188 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
14189 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
14192 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
14193 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
14198 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
14199 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
14200 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
14201 .and. num_conti.le.maxconts) then
14202 ! write (iout,*) i,j," entered corr"
14204 ! Calculate the contact function. The ith column of the array JCONT will
14205 ! contain the numbers of atoms that make contacts with the atom I (of numbers
14206 ! greater than I). The arrays FACONT and GACONT will contain the values of
14207 ! the contact function and its derivative.
14208 ! r0ij=1.02D0*rpp(iteli,itelj)
14209 ! r0ij=1.11D0*rpp(iteli,itelj)
14210 r0ij=2.20D0*rpp(iteli,itelj)
14211 ! r0ij=1.55D0*rpp(iteli,itelj)
14212 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
14213 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14214 if (fcont.gt.0.0D0) then
14215 num_conti=num_conti+1
14216 if (num_conti.gt.maxconts) then
14217 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14218 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
14219 ' will skip next contacts for this conf.',num_conti
14221 jcont_hb(num_conti,i)=j
14222 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
14223 !d & " jcont_hb",jcont_hb(num_conti,i)
14224 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
14225 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14226 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
14228 d_cont(num_conti,i)=rij
14229 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
14230 ! --- Electrostatic-interaction matrix ---
14231 a_chuj(1,1,num_conti,i)=a22
14232 a_chuj(1,2,num_conti,i)=a23
14233 a_chuj(2,1,num_conti,i)=a32
14234 a_chuj(2,2,num_conti,i)=a33
14235 ! --- Gradient of rij
14237 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
14244 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
14245 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
14246 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
14247 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
14248 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
14253 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
14254 ! Calculate contact energies
14256 wij=cosa-3.0D0*cosb*cosg
14259 ! fac3=dsqrt(-ael6i)/r0ij**3
14260 fac3=dsqrt(-ael6i)*r3ij
14261 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
14262 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
14263 if (ees0tmp.gt.0) then
14264 ees0pij=dsqrt(ees0tmp)
14268 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
14269 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
14270 if (ees0tmp.gt.0) then
14271 ees0mij=dsqrt(ees0tmp)
14276 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
14279 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
14282 ! Diagnostics. Comment out or remove after debugging!
14283 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
14284 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
14285 ! ees0m(num_conti,i)=0.0D0
14287 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
14288 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
14289 ! Angular derivatives of the contact function
14290 ees0pij1=fac3/ees0pij
14291 ees0mij1=fac3/ees0mij
14292 fac3p=-3.0D0*fac3*rrmij
14293 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
14294 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
14296 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
14297 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
14298 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
14299 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
14300 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
14301 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
14302 ecosap=ecosa1+ecosa2
14303 ecosbp=ecosb1+ecosb2
14304 ecosgp=ecosg1+ecosg2
14305 ecosam=ecosa1-ecosa2
14306 ecosbm=ecosb1-ecosb2
14307 ecosgm=ecosg1-ecosg2
14316 facont_hb(num_conti,i)=fcont
14317 fprimcont=fprimcont/rij
14318 !d facont_hb(num_conti,i)=1.0D0
14319 ! Following line is for diagnostics.
14322 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14323 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14326 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
14327 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
14329 ! gggp(1)=gggp(1)+ees0pijp*xj
14330 ! gggp(2)=gggp(2)+ees0pijp*yj
14331 ! gggp(3)=gggp(3)+ees0pijp*zj
14332 ! gggm(1)=gggm(1)+ees0mijp*xj
14333 ! gggm(2)=gggm(2)+ees0mijp*yj
14334 ! gggm(3)=gggm(3)+ees0mijp*zj
14335 gggp(1)=gggp(1)+ees0pijp*xj &
14336 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14337 gggp(2)=gggp(2)+ees0pijp*yj &
14338 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14339 gggp(3)=gggp(3)+ees0pijp*zj &
14340 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14342 gggm(1)=gggm(1)+ees0mijp*xj &
14343 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14345 gggm(2)=gggm(2)+ees0mijp*yj &
14346 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14348 gggm(3)=gggm(3)+ees0mijp*zj &
14349 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14351 ! Derivatives due to the contact function
14352 gacont_hbr(1,num_conti,i)=fprimcont*xj
14353 gacont_hbr(2,num_conti,i)=fprimcont*yj
14354 gacont_hbr(3,num_conti,i)=fprimcont*zj
14357 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
14358 ! following the change of gradient-summation algorithm.
14360 !grad ghalfp=0.5D0*gggp(k)
14361 !grad ghalfm=0.5D0*gggm(k)
14362 ! gacontp_hb1(k,num_conti,i)= & !ghalfp
14363 ! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14364 ! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14365 ! gacontp_hb2(k,num_conti,i)= & !ghalfp
14366 ! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14367 ! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14368 ! gacontp_hb3(k,num_conti,i)=gggp(k)
14369 ! gacontm_hb1(k,num_conti,i)= &!ghalfm
14370 ! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14371 ! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14372 ! gacontm_hb2(k,num_conti,i)= & !ghalfm
14373 ! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14374 ! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14375 ! gacontm_hb3(k,num_conti,i)=gggm(k)
14376 gacontp_hb1(k,num_conti,i)= & !ghalfp+
14377 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14378 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14381 gacontp_hb2(k,num_conti,i)= & !ghalfp+
14382 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14383 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14386 gacontp_hb3(k,num_conti,i)=gggp(k) &
14389 gacontm_hb1(k,num_conti,i)= & !ghalfm+
14390 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14391 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14394 gacontm_hb2(k,num_conti,i)= & !ghalfm+
14395 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14396 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
14399 gacontm_hb3(k,num_conti,i)=gggm(k) &
14404 endif ! num_conti.le.maxconts
14407 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
14410 ghalf=0.5d0*agg(l,k)
14411 aggi(l,k)=aggi(l,k)+ghalf
14412 aggi1(l,k)=aggi1(l,k)+agg(l,k)
14413 aggj(l,k)=aggj(l,k)+ghalf
14416 if (j.eq.nres-1 .and. i.lt.j-2) then
14419 aggj1(l,k)=aggj1(l,k)+agg(l,k)
14425 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
14427 end subroutine eelecij_scale
14428 !-----------------------------------------------------------------------------
14429 subroutine evdwpp_short(evdw1)
14433 ! implicit real*8 (a-h,o-z)
14434 ! include 'DIMENSIONS'
14435 ! include 'COMMON.CONTROL'
14436 ! include 'COMMON.IOUNITS'
14437 ! include 'COMMON.GEO'
14438 ! include 'COMMON.VAR'
14439 ! include 'COMMON.LOCAL'
14440 ! include 'COMMON.CHAIN'
14441 ! include 'COMMON.DERIV'
14442 ! include 'COMMON.INTERACT'
14443 ! include 'COMMON.CONTACTS'
14444 ! include 'COMMON.TORSION'
14445 ! include 'COMMON.VECTORS'
14446 ! include 'COMMON.FFIELD'
14447 real(kind=8),dimension(3) :: ggg
14448 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14450 real(kind=8) :: scal_el=1.0d0
14452 real(kind=8) :: scal_el=0.5d0
14454 !el local variables
14455 integer :: i,j,k,iteli,itelj,num_conti,isubchap
14456 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
14457 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
14458 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14459 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
14460 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14461 dist_temp, dist_init,sss_grad
14462 integer xshift,yshift,zshift
14466 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
14467 ! & " iatel_e_vdw",iatel_e_vdw
14469 do i=iatel_s_vdw,iatel_e_vdw
14470 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle
14474 dx_normi=dc_norm(1,i)
14475 dy_normi=dc_norm(2,i)
14476 dz_normi=dc_norm(3,i)
14477 xmedi=c(1,i)+0.5d0*dxi
14478 ymedi=c(2,i)+0.5d0*dyi
14479 zmedi=c(3,i)+0.5d0*dzi
14480 xmedi=dmod(xmedi,boxxsize)
14481 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14482 ymedi=dmod(ymedi,boxysize)
14483 if (ymedi.lt.0) ymedi=ymedi+boxysize
14484 zmedi=dmod(zmedi,boxzsize)
14485 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14487 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
14488 ! & ' ielend',ielend_vdw(i)
14490 do j=ielstart_vdw(i),ielend_vdw(i)
14491 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
14495 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14496 aaa=app(iteli,itelj)
14497 bbb=bpp(iteli,itelj)
14501 dx_normj=dc_norm(1,j)
14502 dy_normj=dc_norm(2,j)
14503 dz_normj=dc_norm(3,j)
14504 ! xj=c(1,j)+0.5D0*dxj-xmedi
14505 ! yj=c(2,j)+0.5D0*dyj-ymedi
14506 ! zj=c(3,j)+0.5D0*dzj-zmedi
14507 xj=c(1,j)+0.5D0*dxj
14508 yj=c(2,j)+0.5D0*dyj
14509 zj=c(3,j)+0.5D0*dzj
14510 xj=mod(xj,boxxsize)
14511 if (xj.lt.0) xj=xj+boxxsize
14512 yj=mod(yj,boxysize)
14513 if (yj.lt.0) yj=yj+boxysize
14514 zj=mod(zj,boxzsize)
14515 if (zj.lt.0) zj=zj+boxzsize
14517 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14524 xj=xj_safe+xshift*boxxsize
14525 yj=yj_safe+yshift*boxysize
14526 zj=zj_safe+zshift*boxzsize
14527 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14528 if(dist_temp.lt.dist_init) then
14529 dist_init=dist_temp
14538 if (isubchap.eq.1) then
14549 rij=xj*xj+yj*yj+zj*zj
14552 sss=sscale(rij/rpp(iteli,itelj))
14553 sss_ele_cut=sscale_ele(rij)
14554 sss_ele_grad=sscagrad_ele(rij)
14555 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
14556 if (sss_ele_cut.le.0.0) cycle
14557 if (sss.gt.0.0d0) then
14562 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
14563 if (j.eq.i+2) ev1=scal_el*ev1
14566 if (energy_dec) then
14567 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
14569 evdw1=evdw1+evdwij*sss*sss_ele_cut
14571 ! Calculate contributions to the Cartesian gradient.
14573 facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
14577 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
14578 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14579 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
14580 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14581 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
14582 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14585 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14586 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14592 end subroutine evdwpp_short
14593 !-----------------------------------------------------------------------------
14594 subroutine escp_long(evdw2,evdw2_14)
14596 ! This subroutine calculates the excluded-volume interaction energy between
14597 ! peptide-group centers and side chains and its gradient in virtual-bond and
14598 ! side-chain vectors.
14600 ! implicit real*8 (a-h,o-z)
14601 ! include 'DIMENSIONS'
14602 ! include 'COMMON.GEO'
14603 ! include 'COMMON.VAR'
14604 ! include 'COMMON.LOCAL'
14605 ! include 'COMMON.CHAIN'
14606 ! include 'COMMON.DERIV'
14607 ! include 'COMMON.INTERACT'
14608 ! include 'COMMON.FFIELD'
14609 ! include 'COMMON.IOUNITS'
14610 ! include 'COMMON.CONTROL'
14611 real(kind=8),dimension(3) :: ggg
14612 !el local variables
14613 integer :: i,iint,j,k,iteli,itypj,subchap
14614 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
14615 real(kind=8) :: evdw2,evdw2_14,evdwij
14616 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14617 dist_temp, dist_init
14621 !d print '(a)','Enter ESCP'
14622 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
14623 do i=iatscp_s,iatscp_e
14624 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
14626 xi=0.5D0*(c(1,i)+c(1,i+1))
14627 yi=0.5D0*(c(2,i)+c(2,i+1))
14628 zi=0.5D0*(c(3,i)+c(3,i+1))
14629 xi=mod(xi,boxxsize)
14630 if (xi.lt.0) xi=xi+boxxsize
14631 yi=mod(yi,boxysize)
14632 if (yi.lt.0) yi=yi+boxysize
14633 zi=mod(zi,boxzsize)
14634 if (zi.lt.0) zi=zi+boxzsize
14636 do iint=1,nscp_gr(i)
14638 do j=iscpstart(i,iint),iscpend(i,iint)
14640 if (itypj.eq.ntyp1) cycle
14641 ! Uncomment following three lines for SC-p interactions
14642 ! xj=c(1,nres+j)-xi
14643 ! yj=c(2,nres+j)-yi
14644 ! zj=c(3,nres+j)-zi
14645 ! Uncomment following three lines for Ca-p interactions
14649 xj=mod(xj,boxxsize)
14650 if (xj.lt.0) xj=xj+boxxsize
14651 yj=mod(yj,boxysize)
14652 if (yj.lt.0) yj=yj+boxysize
14653 zj=mod(zj,boxzsize)
14654 if (zj.lt.0) zj=zj+boxzsize
14655 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14663 xj=xj_safe+xshift*boxxsize
14664 yj=yj_safe+yshift*boxysize
14665 zj=zj_safe+zshift*boxzsize
14666 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14667 if(dist_temp.lt.dist_init) then
14668 dist_init=dist_temp
14677 if (subchap.eq.1) then
14686 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14688 rij=dsqrt(1.0d0/rrij)
14689 sss_ele_cut=sscale_ele(rij)
14690 sss_ele_grad=sscagrad_ele(rij)
14691 ! print *,sss_ele_cut,sss_ele_grad,&
14692 ! (rij),r_cut_ele,rlamb_ele
14693 if (sss_ele_cut.le.0.0) cycle
14694 sss=sscale((rij/rscp(itypj,iteli)))
14695 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
14696 if (sss.lt.1.0d0) then
14699 e1=fac*fac*aad(itypj,iteli)
14700 e2=fac*bad(itypj,iteli)
14701 if (iabs(j-i) .le. 2) then
14704 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
14707 evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
14708 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
14709 'evdw2',i,j,sss,evdwij
14711 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
14713 fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
14714 fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
14715 -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
14719 ! Uncomment following three lines for SC-p interactions
14721 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
14723 ! Uncomment following line for SC-p interactions
14724 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
14726 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
14727 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
14736 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
14737 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
14738 gradx_scp(j,i)=expon*gradx_scp(j,i)
14741 !******************************************************************************
14745 ! To save time the factor EXPON has been extracted from ALL components
14746 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
14749 !******************************************************************************
14751 end subroutine escp_long
14752 !-----------------------------------------------------------------------------
14753 subroutine escp_short(evdw2,evdw2_14)
14755 ! This subroutine calculates the excluded-volume interaction energy between
14756 ! peptide-group centers and side chains and its gradient in virtual-bond and
14757 ! side-chain vectors.
14759 ! implicit real*8 (a-h,o-z)
14760 ! include 'DIMENSIONS'
14761 ! include 'COMMON.GEO'
14762 ! include 'COMMON.VAR'
14763 ! include 'COMMON.LOCAL'
14764 ! include 'COMMON.CHAIN'
14765 ! include 'COMMON.DERIV'
14766 ! include 'COMMON.INTERACT'
14767 ! include 'COMMON.FFIELD'
14768 ! include 'COMMON.IOUNITS'
14769 ! include 'COMMON.CONTROL'
14770 real(kind=8),dimension(3) :: ggg
14771 !el local variables
14772 integer :: i,iint,j,k,iteli,itypj,subchap
14773 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
14774 real(kind=8) :: evdw2,evdw2_14,evdwij
14775 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14776 dist_temp, dist_init
14780 !d print '(a)','Enter ESCP'
14781 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
14782 do i=iatscp_s,iatscp_e
14783 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
14785 xi=0.5D0*(c(1,i)+c(1,i+1))
14786 yi=0.5D0*(c(2,i)+c(2,i+1))
14787 zi=0.5D0*(c(3,i)+c(3,i+1))
14788 xi=mod(xi,boxxsize)
14789 if (xi.lt.0) xi=xi+boxxsize
14790 yi=mod(yi,boxysize)
14791 if (yi.lt.0) yi=yi+boxysize
14792 zi=mod(zi,boxzsize)
14793 if (zi.lt.0) zi=zi+boxzsize
14795 do iint=1,nscp_gr(i)
14797 do j=iscpstart(i,iint),iscpend(i,iint)
14799 if (itypj.eq.ntyp1) cycle
14800 ! Uncomment following three lines for SC-p interactions
14801 ! xj=c(1,nres+j)-xi
14802 ! yj=c(2,nres+j)-yi
14803 ! zj=c(3,nres+j)-zi
14804 ! Uncomment following three lines for Ca-p interactions
14811 xj=mod(xj,boxxsize)
14812 if (xj.lt.0) xj=xj+boxxsize
14813 yj=mod(yj,boxysize)
14814 if (yj.lt.0) yj=yj+boxysize
14815 zj=mod(zj,boxzsize)
14816 if (zj.lt.0) zj=zj+boxzsize
14817 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14825 xj=xj_safe+xshift*boxxsize
14826 yj=yj_safe+yshift*boxysize
14827 zj=zj_safe+zshift*boxzsize
14828 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14829 if(dist_temp.lt.dist_init) then
14830 dist_init=dist_temp
14839 if (subchap.eq.1) then
14849 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14850 rij=dsqrt(1.0d0/rrij)
14851 sss_ele_cut=sscale_ele(rij)
14852 sss_ele_grad=sscagrad_ele(rij)
14853 ! print *,sss_ele_cut,sss_ele_grad,&
14854 ! (rij),r_cut_ele,rlamb_ele
14855 if (sss_ele_cut.le.0.0) cycle
14856 sss=sscale(rij/rscp(itypj,iteli))
14857 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
14858 if (sss.gt.0.0d0) then
14861 e1=fac*fac*aad(itypj,iteli)
14862 e2=fac*bad(itypj,iteli)
14863 if (iabs(j-i) .le. 2) then
14866 evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
14869 evdw2=evdw2+evdwij*sss*sss_ele_cut
14870 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
14871 'evdw2',i,j,sss,evdwij
14873 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
14875 fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
14876 fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
14877 +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
14882 ! Uncomment following three lines for SC-p interactions
14884 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
14886 ! Uncomment following line for SC-p interactions
14887 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
14889 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
14890 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
14899 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
14900 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
14901 gradx_scp(j,i)=expon*gradx_scp(j,i)
14904 !******************************************************************************
14908 ! To save time the factor EXPON has been extracted from ALL components
14909 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
14912 !******************************************************************************
14914 end subroutine escp_short
14915 !-----------------------------------------------------------------------------
14916 ! energy_p_new-sep_barrier.F
14917 !-----------------------------------------------------------------------------
14918 subroutine sc_grad_scale(scalfac)
14919 ! implicit real*8 (a-h,o-z)
14921 ! include 'DIMENSIONS'
14922 ! include 'COMMON.CHAIN'
14923 ! include 'COMMON.DERIV'
14924 ! include 'COMMON.CALC'
14925 ! include 'COMMON.IOUNITS'
14926 real(kind=8),dimension(3) :: dcosom1,dcosom2
14927 real(kind=8) :: scalfac
14928 !el local variables
14929 ! integer :: i,j,k,l
14931 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
14932 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
14933 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
14934 -2.0D0*alf12*eps3der+sigder*sigsq_om12
14938 ! eom12=evdwij*eps1_om12
14940 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
14941 ! & " sigder",sigder
14942 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
14943 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
14945 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
14946 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
14949 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
14952 ! write (iout,*) "gg",(gg(k),k=1,3)
14954 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
14955 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
14956 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
14958 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
14959 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
14960 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
14962 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
14963 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
14964 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
14965 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
14968 ! Calculate the components of the gradient in DC and X
14971 gvdwc(l,i)=gvdwc(l,i)-gg(l)
14972 gvdwc(l,j)=gvdwc(l,j)+gg(l)
14975 end subroutine sc_grad_scale
14976 !-----------------------------------------------------------------------------
14977 ! energy_split-sep.F
14978 !-----------------------------------------------------------------------------
14979 subroutine etotal_long(energia)
14981 ! Compute the long-range slow-varying contributions to the energy
14983 ! implicit real*8 (a-h,o-z)
14984 ! include 'DIMENSIONS'
14985 use MD_data, only: totT,usampl,eq_time
14989 !MS$ATTRIBUTES C :: proc_proc
14994 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
14996 ! include 'COMMON.SETUP'
14997 ! include 'COMMON.IOUNITS'
14998 ! include 'COMMON.FFIELD'
14999 ! include 'COMMON.DERIV'
15000 ! include 'COMMON.INTERACT'
15001 ! include 'COMMON.SBRIDGE'
15002 ! include 'COMMON.CHAIN'
15003 ! include 'COMMON.VAR'
15004 ! include 'COMMON.LOCAL'
15005 ! include 'COMMON.MD'
15006 real(kind=8),dimension(0:n_ene) :: energia
15007 !el local variables
15008 integer :: i,n_corr,n_corr1,ierror,ierr
15009 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
15010 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
15011 ecorr,ecorr5,ecorr6,eturn6,time00
15012 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
15013 !elwrite(iout,*)"in etotal long"
15015 if (modecalc.eq.12.or.modecalc.eq.14) then
15017 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
15019 call int_from_cart1(.false.)
15022 !elwrite(iout,*)"in etotal long"
15025 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
15026 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15028 if (nfgtasks.gt.1) then
15030 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15031 if (fg_rank.eq.0) then
15032 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
15033 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15035 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15036 ! FG slaves as WEIGHTS array.
15043 weights_(7)=wel_loc
15046 weights_(10)=wturn6
15048 weights_(12)=wscloc
15050 weights_(14)=wtor_d
15051 weights_(15)=wstrain
15052 weights_(16)=wvdwpp
15054 weights_(18)=scal14
15055 weights_(21)=wsccor
15056 ! FG Master broadcasts the WEIGHTS_ array
15057 call MPI_Bcast(weights_(1),n_ene,&
15058 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15060 ! FG slaves receive the WEIGHTS array
15061 call MPI_Bcast(weights(1),n_ene,&
15062 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15077 wstrain=weights(15)
15083 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
15085 time_Bcast=time_Bcast+MPI_Wtime()-time00
15086 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
15087 ! call chainbuild_cart
15088 ! call int_from_cart1(.false.)
15090 ! write (iout,*) 'Processor',myrank,
15091 ! & ' calling etotal_short ipot=',ipot
15093 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15095 !d print *,'nnt=',nnt,' nct=',nct
15097 !elwrite(iout,*)"in etotal long"
15098 ! Compute the side-chain and electrostatic interaction energy
15100 goto (101,102,103,104,105,106) ipot
15101 ! Lennard-Jones potential.
15102 101 call elj_long(evdw)
15103 !d print '(a)','Exit ELJ'
15105 ! Lennard-Jones-Kihara potential (shifted).
15106 102 call eljk_long(evdw)
15108 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15109 103 call ebp_long(evdw)
15111 ! Gay-Berne potential (shifted LJ, angular dependence).
15112 104 call egb_long(evdw)
15114 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15115 105 call egbv_long(evdw)
15117 ! Soft-sphere potential
15118 106 call e_softsphere(evdw)
15120 ! Calculate electrostatic (H-bonding) energy of the main chain.
15124 if (ipot.lt.6) then
15126 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
15127 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15128 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15129 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15131 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
15132 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15133 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15134 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15136 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
15145 ! write (iout,*) "Soft-spheer ELEC potential"
15146 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
15150 ! Calculate excluded-volume interaction energy between peptide groups
15153 if (ipot.lt.6) then
15154 if(wscp.gt.0d0) then
15155 call escp_long(evdw2,evdw2_14)
15161 call escp_soft_sphere(evdw2,evdw2_14)
15164 ! 12/1/95 Multi-body terms
15168 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
15169 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
15170 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
15171 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
15172 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
15179 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
15180 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
15183 ! If performing constraint dynamics, call the constraint energy
15184 ! after the equilibration time
15185 if(usampl.and.totT.gt.eq_time) then
15200 energia(2)=evdw2-evdw2_14
15201 energia(18)=evdw2_14
15210 energia(3)=ees+evdw1
15217 energia(8)=eello_turn3
15218 energia(9)=eello_turn4
15220 energia(20)=Uconst+Uconst_back
15221 call sum_energy(energia,.true.)
15222 ! write (iout,*) "Exit ETOTAL_LONG"
15225 end subroutine etotal_long
15226 !-----------------------------------------------------------------------------
15227 subroutine etotal_short(energia)
15229 ! Compute the short-range fast-varying contributions to the energy
15231 ! implicit real*8 (a-h,o-z)
15232 ! include 'DIMENSIONS'
15236 !MS$ATTRIBUTES C :: proc_proc
15241 integer :: ierror,ierr
15242 real(kind=8),dimension(n_ene) :: weights_
15243 real(kind=8) :: time00
15245 ! include 'COMMON.SETUP'
15246 ! include 'COMMON.IOUNITS'
15247 ! include 'COMMON.FFIELD'
15248 ! include 'COMMON.DERIV'
15249 ! include 'COMMON.INTERACT'
15250 ! include 'COMMON.SBRIDGE'
15251 ! include 'COMMON.CHAIN'
15252 ! include 'COMMON.VAR'
15253 ! include 'COMMON.LOCAL'
15254 real(kind=8),dimension(0:n_ene) :: energia
15255 !el local variables
15257 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
15258 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr
15261 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
15263 if (modecalc.eq.12.or.modecalc.eq.14) then
15265 if (fg_rank.eq.0) call int_from_cart1(.false.)
15267 call int_from_cart1(.false.)
15271 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
15272 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15274 if (nfgtasks.gt.1) then
15276 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15277 if (fg_rank.eq.0) then
15278 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
15279 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15281 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15282 ! FG slaves as WEIGHTS array.
15289 weights_(7)=wel_loc
15292 weights_(10)=wturn6
15294 weights_(12)=wscloc
15296 weights_(14)=wtor_d
15297 weights_(15)=wstrain
15298 weights_(16)=wvdwpp
15300 weights_(18)=scal14
15301 weights_(21)=wsccor
15302 ! FG Master broadcasts the WEIGHTS_ array
15303 call MPI_Bcast(weights_(1),n_ene,&
15304 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15306 ! FG slaves receive the WEIGHTS array
15307 call MPI_Bcast(weights(1),n_ene,&
15308 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15323 wstrain=weights(15)
15329 ! write (iout,*),"Processor",myrank," BROADCAST weights"
15330 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
15332 ! write (iout,*) "Processor",myrank," BROADCAST c"
15333 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
15335 ! write (iout,*) "Processor",myrank," BROADCAST dc"
15336 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
15338 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
15339 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
15341 ! write (iout,*) "Processor",myrank," BROADCAST theta"
15342 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
15344 ! write (iout,*) "Processor",myrank," BROADCAST phi"
15345 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
15347 ! write (iout,*) "Processor",myrank," BROADCAST alph"
15348 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
15350 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
15351 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
15353 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
15354 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
15356 time_Bcast=time_Bcast+MPI_Wtime()-time00
15357 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
15359 ! write (iout,*) 'Processor',myrank,
15360 ! & ' calling etotal_short ipot=',ipot
15362 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15364 ! call int_from_cart1(.false.)
15366 ! Compute the side-chain and electrostatic interaction energy
15368 goto (101,102,103,104,105,106) ipot
15369 ! Lennard-Jones potential.
15370 101 call elj_short(evdw)
15371 !d print '(a)','Exit ELJ'
15373 ! Lennard-Jones-Kihara potential (shifted).
15374 102 call eljk_short(evdw)
15376 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15377 103 call ebp_short(evdw)
15379 ! Gay-Berne potential (shifted LJ, angular dependence).
15380 104 call egb_short(evdw)
15382 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15383 105 call egbv_short(evdw)
15385 ! Soft-sphere potential - already dealt with in the long-range part
15387 ! 106 call e_softsphere_short(evdw)
15389 ! Calculate electrostatic (H-bonding) energy of the main chain.
15393 ! Calculate the short-range part of Evdwpp
15395 call evdwpp_short(evdw1)
15397 ! Calculate the short-range part of ESCp
15399 if (ipot.lt.6) then
15400 call escp_short(evdw2,evdw2_14)
15403 ! Calculate the bond-stretching energy
15407 ! Calculate the disulfide-bridge and other energy and the contributions
15408 ! from other distance constraints.
15411 ! Calculate the virtual-bond-angle energy.
15415 ! Calculate the SC local energy.
15420 ! Calculate the virtual-bond torsional energy.
15422 call etor(etors,edihcnstr)
15424 ! 6/23/01 Calculate double-torsional energy
15426 call etor_d(etors_d)
15428 ! 21/5/07 Calculate local sicdechain correlation energy
15430 if (wsccor.gt.0.0d0) then
15431 call eback_sc_corr(esccor)
15436 ! Put energy components into an array
15443 energia(2)=evdw2-evdw2_14
15444 energia(18)=evdw2_14
15457 energia(14)=etors_d
15460 energia(19)=edihcnstr
15462 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
15464 call sum_energy(energia,.true.)
15465 ! write (iout,*) "Exit ETOTAL_SHORT"
15468 end subroutine etotal_short
15469 !-----------------------------------------------------------------------------
15471 !-----------------------------------------------------------------------------
15472 real(kind=8) function gnmr1(y,ymin,ymax)
15474 real(kind=8) :: y,ymin,ymax
15475 real(kind=8) :: wykl=4.0d0
15476 if (y.lt.ymin) then
15477 gnmr1=(ymin-y)**wykl/wykl
15478 else if (y.gt.ymax) then
15479 gnmr1=(y-ymax)**wykl/wykl
15485 !-----------------------------------------------------------------------------
15486 real(kind=8) function gnmr1prim(y,ymin,ymax)
15488 real(kind=8) :: y,ymin,ymax
15489 real(kind=8) :: wykl=4.0d0
15490 if (y.lt.ymin) then
15491 gnmr1prim=-(ymin-y)**(wykl-1)
15492 else if (y.gt.ymax) then
15493 gnmr1prim=(y-ymax)**(wykl-1)
15498 end function gnmr1prim
15499 !-----------------------------------------------------------------------------
15500 real(kind=8) function harmonic(y,ymax)
15502 real(kind=8) :: y,ymax
15503 real(kind=8) :: wykl=2.0d0
15504 harmonic=(y-ymax)**wykl
15506 end function harmonic
15507 !-----------------------------------------------------------------------------
15508 real(kind=8) function harmonicprim(y,ymax)
15509 real(kind=8) :: y,ymin,ymax
15510 real(kind=8) :: wykl=2.0d0
15511 harmonicprim=(y-ymax)*wykl
15513 end function harmonicprim
15514 !-----------------------------------------------------------------------------
15516 !-----------------------------------------------------------------------------
15517 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
15519 use io_base, only:intout,briefout
15520 ! implicit real*8 (a-h,o-z)
15521 ! include 'DIMENSIONS'
15522 ! include 'COMMON.CHAIN'
15523 ! include 'COMMON.DERIV'
15524 ! include 'COMMON.VAR'
15525 ! include 'COMMON.INTERACT'
15526 ! include 'COMMON.FFIELD'
15527 ! include 'COMMON.MD'
15528 ! include 'COMMON.IOUNITS'
15529 real(kind=8),external :: ufparm
15530 integer :: uiparm(1)
15531 real(kind=8) :: urparm(1)
15532 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
15533 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
15534 integer :: n,nf,ind,ind1,i,k,j
15536 ! This subroutine calculates total internal coordinate gradient.
15537 ! Depending on the number of function evaluations, either whole energy
15538 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
15539 ! internal coordinates are reevaluated or only the cartesian-in-internal
15540 ! coordinate derivatives are evaluated. The subroutine was designed to work
15546 !d print *,'grad',nf,icg
15547 if (nf-nfl+1) 20,30,40
15548 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
15549 ! write (iout,*) 'grad 20'
15550 if (nf.eq.0) return
15552 30 call var_to_geom(n,x)
15554 ! write (iout,*) 'grad 30'
15556 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
15559 ! write (iout,*) 'grad 40'
15560 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
15562 ! Convert the Cartesian gradient into internal-coordinate gradient.
15572 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
15574 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
15577 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
15583 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
15585 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
15586 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
15589 if (i.gt.1) g(i-1)=gphii
15590 if (n.gt.nphi) g(nphi+i)=gthetai
15592 if (n.le.nphi+ntheta) goto 10
15594 if (itype(i).ne.10) then
15598 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
15601 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
15603 g(ialph(i,1))=galphai
15604 g(ialph(i,1)+nside)=gomegai
15608 ! Add the components corresponding to local energy terms.
15612 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
15613 g(i)=g(i)+gloc(i,icg)
15615 ! Uncomment following three lines for diagnostics.
15617 !elwrite(iout,*) "in gradient after calling intout"
15618 !d call briefout(0,0.0d0)
15619 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
15621 end subroutine gradient
15622 !-----------------------------------------------------------------------------
15623 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
15626 ! implicit real*8 (a-h,o-z)
15627 ! include 'DIMENSIONS'
15628 ! include 'COMMON.DERIV'
15629 ! include 'COMMON.IOUNITS'
15630 ! include 'COMMON.GEO'
15633 !el common /chuju/ jjj
15634 real(kind=8) :: energia(0:n_ene)
15635 integer :: uiparm(1)
15636 real(kind=8) :: urparm(1)
15638 real(kind=8),external :: ufparm
15639 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
15640 ! if (jjj.gt.0) then
15641 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
15645 !d print *,'func',nf,nfl,icg
15646 call var_to_geom(n,x)
15649 !d write (iout,*) 'ETOTAL called from FUNC'
15650 call etotal(energia)
15653 ! if (jjj.gt.0) then
15654 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
15655 ! write (iout,*) 'f=',etot
15659 end subroutine func
15660 !-----------------------------------------------------------------------------
15661 subroutine cartgrad
15662 ! implicit real*8 (a-h,o-z)
15663 ! include 'DIMENSIONS'
15665 use MD_data, only: totT,usampl,eq_time
15669 ! include 'COMMON.CHAIN'
15670 ! include 'COMMON.DERIV'
15671 ! include 'COMMON.VAR'
15672 ! include 'COMMON.INTERACT'
15673 ! include 'COMMON.FFIELD'
15674 ! include 'COMMON.MD'
15675 ! include 'COMMON.IOUNITS'
15676 ! include 'COMMON.TIME1'
15680 ! This subrouting calculates total Cartesian coordinate gradient.
15681 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
15691 !el write (iout,*) "After sum_gradient"
15693 !el write (iout,*) "After sum_gradient"
15695 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
15696 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
15699 ! If performing constraint dynamics, add the gradients of the constraint energy
15700 if(usampl.and.totT.gt.eq_time) then
15703 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
15704 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
15708 gloc(i,icg)=gloc(i,icg)+dugamma(i)
15711 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
15714 !elwrite (iout,*) "After sum_gradient"
15719 !elwrite (iout,*) "After sum_gradient"
15721 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
15723 ! call checkintcartgrad
15724 ! write(iout,*) 'calling int_to_cart'
15726 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
15730 gcart(j,i)=gradc(j,i,icg)
15731 gxcart(j,i)=gradx(j,i,icg)
15734 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
15735 (gxcart(j,i),j=1,3),gloc(i,icg)
15743 time_inttocart=time_inttocart+MPI_Wtime()-time01
15746 write (iout,*) "gcart and gxcart after int_to_cart"
15748 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
15749 (gxcart(j,i),j=1,3)
15754 write (iout,*) "CARGRAD"
15758 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
15759 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
15761 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
15762 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
15764 ! Correction: dummy residues
15767 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
15768 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
15771 if (nct.lt.nres) then
15773 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
15774 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
15779 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
15783 end subroutine cartgrad
15784 !-----------------------------------------------------------------------------
15785 subroutine zerograd
15786 ! implicit real*8 (a-h,o-z)
15787 ! include 'DIMENSIONS'
15788 ! include 'COMMON.DERIV'
15789 ! include 'COMMON.CHAIN'
15790 ! include 'COMMON.VAR'
15791 ! include 'COMMON.MD'
15792 ! include 'COMMON.SCCOR'
15794 !el local variables
15795 integer :: i,j,intertyp,k
15796 ! Initialize Cartesian-coordinate gradient
15798 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
15799 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
15801 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
15802 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
15803 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
15804 ! allocate(gradcorr_long(3,nres))
15805 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
15806 ! allocate(gcorr6_turn_long(3,nres))
15807 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
15809 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
15811 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
15812 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
15814 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
15815 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
15817 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
15818 ! allocate(gscloc(3,nres)) !(3,maxres)
15819 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
15823 ! common /deriv_scloc/
15824 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
15825 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
15826 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
15828 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
15832 ! gradc(j,i,icg)=0.0d0
15833 ! gradx(j,i,icg)=0.0d0
15835 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
15836 !elwrite(iout,*) "icg",icg
15840 gradx_scp(j,i)=0.0D0
15842 gvdwc_scp(j,i)=0.0D0
15843 gvdwc_scpp(j,i)=0.0d0
15845 gelc_long(j,i)=0.0D0
15850 gel_loc_long(j,i)=0.0d0
15853 gcorr3_turn(j,i)=0.0d0
15854 gcorr4_turn(j,i)=0.0d0
15855 gradcorr(j,i)=0.0d0
15856 gradcorr_long(j,i)=0.0d0
15857 gradcorr5_long(j,i)=0.0d0
15858 gradcorr6_long(j,i)=0.0d0
15859 gcorr6_turn_long(j,i)=0.0d0
15860 gradcorr5(j,i)=0.0d0
15861 gradcorr6(j,i)=0.0d0
15862 gcorr6_turn(j,i)=0.0d0
15865 gradc(j,i,icg)=0.0d0
15866 gradx(j,i,icg)=0.0d0
15869 gliptran(j,i)=0.0d0
15870 gliptranx(j,i)=0.0d0
15871 gliptranc(j,i)=0.0d0
15872 gshieldx(j,i)=0.0d0
15873 gshieldc(j,i)=0.0d0
15874 gshieldc_loc(j,i)=0.0d0
15875 gshieldx_ec(j,i)=0.0d0
15876 gshieldc_ec(j,i)=0.0d0
15877 gshieldc_loc_ec(j,i)=0.0d0
15878 gshieldx_t3(j,i)=0.0d0
15879 gshieldc_t3(j,i)=0.0d0
15880 gshieldc_loc_t3(j,i)=0.0d0
15881 gshieldx_t4(j,i)=0.0d0
15882 gshieldc_t4(j,i)=0.0d0
15883 gshieldc_loc_t4(j,i)=0.0d0
15884 gshieldx_ll(j,i)=0.0d0
15885 gshieldc_ll(j,i)=0.0d0
15886 gshieldc_loc_ll(j,i)=0.0d0
15888 gg_tube_sc(j,i)=0.0d0
15890 gloc_sc(intertyp,i,icg)=0.0d0
15899 grad_shield_side(k,j,i)=0.0d0
15900 grad_shield_loc(k,j,i)=0.0d0
15907 ! Initialize the gradient of local energy terms.
15909 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
15910 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
15911 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
15912 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
15913 ! allocate(gel_loc_turn3(nres))
15914 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
15915 ! allocate(gsccor_loc(nres)) !(maxres)
15921 gel_loc_loc(i)=0.0d0
15923 g_corr5_loc(i)=0.0d0
15924 g_corr6_loc(i)=0.0d0
15925 gel_loc_turn3(i)=0.0d0
15926 gel_loc_turn4(i)=0.0d0
15927 gel_loc_turn6(i)=0.0d0
15928 gsccor_loc(i)=0.0d0
15930 ! initialize gcart and gxcart
15931 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
15939 end subroutine zerograd
15940 !-----------------------------------------------------------------------------
15941 real(kind=8) function fdum()
15945 !-----------------------------------------------------------------------------
15947 !-----------------------------------------------------------------------------
15948 subroutine intcartderiv
15949 ! implicit real*8 (a-h,o-z)
15950 ! include 'DIMENSIONS'
15954 ! include 'COMMON.SETUP'
15955 ! include 'COMMON.CHAIN'
15956 ! include 'COMMON.VAR'
15957 ! include 'COMMON.GEO'
15958 ! include 'COMMON.INTERACT'
15959 ! include 'COMMON.DERIV'
15960 ! include 'COMMON.IOUNITS'
15961 ! include 'COMMON.LOCAL'
15962 ! include 'COMMON.SCCOR'
15963 real(kind=8) :: pi4,pi34
15964 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
15965 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
15966 dcosomega,dsinomega !(3,3,maxres)
15967 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
15970 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
15971 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
15972 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
15973 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
15977 !el from module energy-------------
15978 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
15979 !el allocate(dsintau(3,3,3,itau_start:itau_end))
15980 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
15982 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
15983 !el allocate(dsintau(3,3,3,0:nres2))
15984 !el allocate(dtauangle(3,3,3,0:nres2))
15985 !el allocate(domicron(3,2,2,0:nres2))
15986 !el allocate(dcosomicron(3,2,2,0:nres2))
15990 #if defined(MPI) && defined(PARINTDER)
15991 if (nfgtasks.gt.1 .and. me.eq.king) &
15992 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
15997 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
15998 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
16000 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
16003 dtheta(j,1,i)=0.0d0
16004 dtheta(j,2,i)=0.0d0
16010 ! Derivatives of theta's
16011 #if defined(MPI) && defined(PARINTDER)
16012 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16013 do i=max0(ithet_start-1,3),ithet_end
16017 cost=dcos(theta(i))
16018 sint=sqrt(1-cost*cost)
16020 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
16022 if (itype(i-1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
16023 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
16025 if (itype(i-1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
16028 #if defined(MPI) && defined(PARINTDER)
16029 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16030 do i=max0(ithet_start-1,3),ithet_end
16034 if ((itype(i-1).ne.10).and.(itype(i-1).ne.ntyp1)) then
16035 cost1=dcos(omicron(1,i))
16036 sint1=sqrt(1-cost1*cost1)
16037 cost2=dcos(omicron(2,i))
16038 sint2=sqrt(1-cost2*cost2)
16040 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
16041 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
16042 cost1*dc_norm(j,i-2))/ &
16044 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
16045 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
16046 +cost1*(dc_norm(j,i-1+nres)))/ &
16048 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
16049 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
16050 !C Looks messy but better than if in loop
16051 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
16052 +cost2*dc_norm(j,i-1))/ &
16054 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
16055 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
16056 +cost2*(-dc_norm(j,i-1+nres)))/ &
16058 ! write(iout,*) "vbld", i,itype(i),vbld(i-1+nres)
16059 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
16063 !elwrite(iout,*) "after vbld write"
16064 ! Derivatives of phi:
16065 ! If phi is 0 or 180 degrees, then the formulas
16066 ! have to be derived by power series expansion of the
16067 ! conventional formulas around 0 and 180.
16069 do i=iphi1_start,iphi1_end
16073 ! if (itype(i-1).eq.21 .or. itype(i-2).eq.21 ) cycle
16074 ! the conventional case
16075 sint=dsin(theta(i))
16076 sint1=dsin(theta(i-1))
16078 cost=dcos(theta(i))
16079 cost1=dcos(theta(i-1))
16081 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
16082 fac0=1.0d0/(sint1*sint)
16085 fac3=cosg*cost1/(sint1*sint1)
16086 fac4=cosg*cost/(sint*sint)
16087 ! Obtaining the gamma derivatives from sine derivative
16088 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
16089 phi(i).gt.pi34.and.phi(i).le.pi.or. &
16090 phi(i).ge.-pi.and.phi(i).le.-pi34) then
16091 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16092 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
16093 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16097 cosg_inv=1.0d0/cosg
16098 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
16099 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16100 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
16101 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
16103 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
16104 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16105 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
16106 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
16107 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16108 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16109 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
16111 ! Bug fixed 3/24/05 (AL)
16113 ! Obtaining the gamma derivatives from cosine derivative
16116 if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then
16117 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16118 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16119 dc_norm(j,i-3))/vbld(i-2)
16120 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
16121 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16122 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16124 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
16125 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16126 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16127 dc_norm(j,i-1))/vbld(i)
16128 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
16133 !alculate derivative of Tauangle
16135 do i=itau_start,itau_end
16138 !elwrite(iout,*) " vecpr",i,nres
16140 if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
16141 ! if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10).or.
16142 ! & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1)) cycle
16143 !c dtauangle(j,intertyp,dervityp,residue number)
16144 !c INTERTYP=1 SC...Ca...Ca..Ca
16145 ! the conventional case
16146 sint=dsin(theta(i))
16147 sint1=dsin(omicron(2,i-1))
16148 sing=dsin(tauangle(1,i))
16149 cost=dcos(theta(i))
16150 cost1=dcos(omicron(2,i-1))
16151 cosg=dcos(tauangle(1,i))
16152 !elwrite(iout,*) " vecpr5",i,nres
16154 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
16155 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
16156 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16157 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
16159 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
16160 fac0=1.0d0/(sint1*sint)
16163 fac3=cosg*cost1/(sint1*sint1)
16164 fac4=cosg*cost/(sint*sint)
16165 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
16166 ! Obtaining the gamma derivatives from sine derivative
16167 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
16168 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
16169 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
16170 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16171 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
16172 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16176 cosg_inv=1.0d0/cosg
16177 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16178 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
16179 *vbld_inv(i-2+nres)
16180 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
16181 dsintau(j,1,2,i)= &
16182 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
16183 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16184 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
16185 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
16186 ! Bug fixed 3/24/05 (AL)
16187 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
16188 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16189 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16190 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
16192 ! Obtaining the gamma derivatives from cosine derivative
16195 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16196 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16197 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
16198 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
16199 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16200 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16202 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
16203 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16204 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
16205 dc_norm(j,i-1))/vbld(i)
16206 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
16207 ! write (iout,*) "else",i
16211 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
16214 !C Second case Ca...Ca...Ca...SC
16216 do i=itau_start,itau_end
16220 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
16221 (itype(i-2).eq.ntyp1).or.(itype(i-3).eq.ntyp1)) cycle
16222 ! the conventional case
16223 sint=dsin(omicron(1,i))
16224 sint1=dsin(theta(i-1))
16225 sing=dsin(tauangle(2,i))
16226 cost=dcos(omicron(1,i))
16227 cost1=dcos(theta(i-1))
16228 cosg=dcos(tauangle(2,i))
16230 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16232 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
16233 fac0=1.0d0/(sint1*sint)
16236 fac3=cosg*cost1/(sint1*sint1)
16237 fac4=cosg*cost/(sint*sint)
16238 ! Obtaining the gamma derivatives from sine derivative
16239 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
16240 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
16241 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
16242 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
16243 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
16244 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16248 cosg_inv=1.0d0/cosg
16249 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16250 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
16251 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
16252 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
16253 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
16254 dsintau(j,2,2,i)= &
16255 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
16256 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16257 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
16258 ! & sing*ctgt*domicron(j,1,2,i),
16259 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16260 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
16261 ! Bug fixed 3/24/05 (AL)
16262 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16263 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
16264 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16265 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
16267 ! Obtaining the gamma derivatives from cosine derivative
16270 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16271 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16272 dc_norm(j,i-3))/vbld(i-2)
16273 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
16274 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16275 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16276 dcosomicron(j,1,1,i)
16277 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
16278 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16279 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16280 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16281 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
16282 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
16287 !CC third case SC...Ca...Ca...SC
16290 do i=itau_start,itau_end
16294 ! the conventional case
16295 if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. &
16296 (itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle
16297 sint=dsin(omicron(1,i))
16298 sint1=dsin(omicron(2,i-1))
16299 sing=dsin(tauangle(3,i))
16300 cost=dcos(omicron(1,i))
16301 cost1=dcos(omicron(2,i-1))
16302 cosg=dcos(tauangle(3,i))
16304 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16305 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16307 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
16308 fac0=1.0d0/(sint1*sint)
16311 fac3=cosg*cost1/(sint1*sint1)
16312 fac4=cosg*cost/(sint*sint)
16313 ! Obtaining the gamma derivatives from sine derivative
16314 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
16315 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
16316 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
16317 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
16318 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
16319 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16323 cosg_inv=1.0d0/cosg
16324 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16325 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
16326 *vbld_inv(i-2+nres)
16327 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
16328 dsintau(j,3,2,i)= &
16329 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
16330 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16331 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
16332 ! Bug fixed 3/24/05 (AL)
16333 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16334 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
16335 *vbld_inv(i-1+nres)
16336 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16337 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
16339 ! Obtaining the gamma derivatives from cosine derivative
16342 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16343 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16344 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
16345 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
16346 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16347 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16348 dcosomicron(j,1,1,i)
16349 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
16350 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16351 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
16352 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16353 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
16354 ! write(iout,*) "else",i
16360 ! Derivatives of side-chain angles alpha and omega
16361 #if defined(MPI) && defined(PARINTDER)
16362 do i=ibond_start,ibond_end
16366 if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then
16367 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
16370 fac8=fac5/vbld(i+1)
16371 fac9=fac5/vbld(i+nres)
16372 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
16373 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
16374 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
16375 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
16376 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
16377 sina=sqrt(1-cosa*cosa)
16379 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
16381 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
16382 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
16383 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
16384 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
16385 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
16386 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
16387 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
16388 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
16390 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
16392 ! obtaining the derivatives of omega from sines
16393 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
16394 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
16395 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
16396 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
16398 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
16399 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
16400 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
16401 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
16402 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
16403 coso_inv=1.0d0/dcos(omeg(i))
16405 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
16406 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
16407 (sino*dc_norm(j,i-1))/vbld(i)
16408 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
16409 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
16410 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
16411 -sino*dc_norm(j,i)/vbld(i+1)
16412 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
16413 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
16414 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
16416 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
16419 ! obtaining the derivatives of omega from cosines
16420 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
16421 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
16426 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
16427 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
16428 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
16429 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
16430 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
16431 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
16432 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
16433 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
16434 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
16435 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
16436 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
16437 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
16438 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
16439 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
16440 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
16446 dalpha(k,j,i)=0.0d0
16447 domega(k,j,i)=0.0d0
16453 #if defined(MPI) && defined(PARINTDER)
16454 if (nfgtasks.gt.1) then
16456 !d write (iout,*) "Gather dtheta"
16457 !d call flush(iout)
16458 write (iout,*) "dtheta before gather"
16460 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
16463 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
16464 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
16465 king,FG_COMM,IERROR)
16467 !d write (iout,*) "Gather dphi"
16468 !d call flush(iout)
16469 write (iout,*) "dphi before gather"
16471 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
16474 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
16475 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
16476 king,FG_COMM,IERROR)
16477 !d write (iout,*) "Gather dalpha"
16478 !d call flush(iout)
16480 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
16481 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
16482 king,FG_COMM,IERROR)
16483 !d write (iout,*) "Gather domega"
16484 !d call flush(iout)
16485 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
16486 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
16487 king,FG_COMM,IERROR)
16492 write (iout,*) "dtheta after gather"
16494 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
16496 write (iout,*) "dphi after gather"
16498 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
16500 write (iout,*) "dalpha after gather"
16502 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
16504 write (iout,*) "domega after gather"
16506 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
16510 end subroutine intcartderiv
16511 !-----------------------------------------------------------------------------
16512 subroutine checkintcartgrad
16513 ! implicit real*8 (a-h,o-z)
16514 ! include 'DIMENSIONS'
16518 ! include 'COMMON.CHAIN'
16519 ! include 'COMMON.VAR'
16520 ! include 'COMMON.GEO'
16521 ! include 'COMMON.INTERACT'
16522 ! include 'COMMON.DERIV'
16523 ! include 'COMMON.IOUNITS'
16524 ! include 'COMMON.SETUP'
16525 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
16526 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
16527 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
16528 real(kind=8),dimension(3) :: dc_norm_s
16529 real(kind=8) :: aincr=1.0d-5
16531 real(kind=8) :: dcji
16534 theta_s(i)=theta(i)
16538 ! Check theta gradient
16540 "Analytical (upper) and numerical (lower) gradient of theta"
16545 dc(j,i-2)=dcji+aincr
16546 call chainbuild_cart
16547 call int_from_cart1(.false.)
16548 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
16551 dc(j,i-1)=dc(j,i-1)+aincr
16552 call chainbuild_cart
16553 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
16556 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
16557 !el (dtheta(j,2,i),j=1,3)
16558 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
16559 !el (dthetanum(j,2,i),j=1,3)
16560 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
16561 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
16562 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
16565 ! Check gamma gradient
16567 "Analytical (upper) and numerical (lower) gradient of gamma"
16571 dc(j,i-3)=dcji+aincr
16572 call chainbuild_cart
16573 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
16576 dc(j,i-2)=dcji+aincr
16577 call chainbuild_cart
16578 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
16581 dc(j,i-1)=dc(j,i-1)+aincr
16582 call chainbuild_cart
16583 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
16586 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
16587 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
16588 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
16589 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
16590 !el write (iout,'(5x,3(3f10.5,5x))') &
16591 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
16592 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
16593 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
16596 ! Check alpha gradient
16598 "Analytical (upper) and numerical (lower) gradient of alpha"
16600 if(itype(i).ne.10) then
16603 dc(j,i-1)=dcji+aincr
16604 call chainbuild_cart
16605 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
16610 call chainbuild_cart
16611 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
16615 dc(j,i+nres)=dc(j,i+nres)+aincr
16616 call chainbuild_cart
16617 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
16622 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
16623 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
16624 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
16625 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
16626 !el write (iout,'(5x,3(3f10.5,5x))') &
16627 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
16628 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
16629 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
16632 ! Check omega gradient
16634 "Analytical (upper) and numerical (lower) gradient of omega"
16636 if(itype(i).ne.10) then
16639 dc(j,i-1)=dcji+aincr
16640 call chainbuild_cart
16641 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
16646 call chainbuild_cart
16647 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
16651 dc(j,i+nres)=dc(j,i+nres)+aincr
16652 call chainbuild_cart
16653 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
16658 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
16659 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
16660 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
16661 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
16662 !el write (iout,'(5x,3(3f10.5,5x))') &
16663 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
16664 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
16665 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
16669 end subroutine checkintcartgrad
16670 !-----------------------------------------------------------------------------
16672 !-----------------------------------------------------------------------------
16673 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
16674 ! implicit real*8 (a-h,o-z)
16675 ! include 'DIMENSIONS'
16676 ! include 'COMMON.IOUNITS'
16677 ! include 'COMMON.CHAIN'
16678 ! include 'COMMON.INTERACT'
16679 ! include 'COMMON.VAR'
16680 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
16681 integer :: kkk,nsep=3
16682 real(kind=8) :: qm !dist,
16683 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
16684 logical :: lprn=.false.
16686 ! real(kind=8) :: sigm,x
16688 !el sigm(x)=0.25d0*x ! local function
16694 do il=seg1+nsep,seg2
16697 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
16698 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
16699 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
16701 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
16702 if (itype(il).ne.10 .or. itype(jl).ne.10) then
16705 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
16706 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
16707 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
16708 dijCM=dist(il+nres,jl+nres)
16709 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
16711 qq = qq+qqij+qqijCM
16717 if((seg3-il).lt.3) then
16724 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
16725 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
16726 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
16728 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
16729 if (itype(il).ne.10 .or. itype(jl).ne.10) then
16732 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
16733 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
16734 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
16735 dijCM=dist(il+nres,jl+nres)
16736 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
16738 qq = qq+qqij+qqijCM
16743 if (qqmax.le.qq) qqmax=qq
16745 qwolynes=1.0d0-qqmax
16747 end function qwolynes
16748 !-----------------------------------------------------------------------------
16749 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
16750 ! implicit real*8 (a-h,o-z)
16751 ! include 'DIMENSIONS'
16752 ! include 'COMMON.IOUNITS'
16753 ! include 'COMMON.CHAIN'
16754 ! include 'COMMON.INTERACT'
16755 ! include 'COMMON.VAR'
16756 ! include 'COMMON.MD'
16757 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
16758 integer :: nsep=3, kkk
16759 !el real(kind=8) :: dist
16760 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
16761 logical :: lprn=.false.
16763 real(kind=8) :: sim,dd0,fac,ddqij
16764 !el sigm(x)=0.25d0*x ! local function
16774 do il=seg1+nsep,seg2
16777 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
16778 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
16779 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
16781 sim = 1.0d0/sigm(d0ij)
16784 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
16786 ddqij = (c(k,il)-c(k,jl))*fac
16787 dqwol(k,il)=dqwol(k,il)+ddqij
16788 dqwol(k,jl)=dqwol(k,jl)-ddqij
16791 if (itype(il).ne.10 .or. itype(jl).ne.10) then
16794 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
16795 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
16796 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
16797 dijCM=dist(il+nres,jl+nres)
16798 sim = 1.0d0/sigm(d0ijCM)
16801 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
16803 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
16804 dxqwol(k,il)=dxqwol(k,il)+ddqij
16805 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
16812 if((seg3-il).lt.3) then
16819 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
16820 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
16821 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
16823 sim = 1.0d0/sigm(d0ij)
16826 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
16828 ddqij = (c(k,il)-c(k,jl))*fac
16829 dqwol(k,il)=dqwol(k,il)+ddqij
16830 dqwol(k,jl)=dqwol(k,jl)-ddqij
16832 if (itype(il).ne.10 .or. itype(jl).ne.10) then
16835 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
16836 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
16837 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
16838 dijCM=dist(il+nres,jl+nres)
16839 sim = 1.0d0/sigm(d0ijCM)
16842 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
16844 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
16845 dxqwol(k,il)=dxqwol(k,il)+ddqij
16846 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
16855 dqwol(j,i)=dqwol(j,i)/nl
16856 dxqwol(j,i)=dxqwol(j,i)/nl
16860 end subroutine qwolynes_prim
16861 !-----------------------------------------------------------------------------
16862 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
16863 ! implicit real*8 (a-h,o-z)
16864 ! include 'DIMENSIONS'
16865 ! include 'COMMON.IOUNITS'
16866 ! include 'COMMON.CHAIN'
16867 ! include 'COMMON.INTERACT'
16868 ! include 'COMMON.VAR'
16869 integer :: seg1,seg2,seg3,seg4
16871 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
16872 real(kind=8),dimension(3,0:2*nres) :: cdummy
16873 real(kind=8) :: q1,q2
16874 real(kind=8) :: delta=1.0d-10
16879 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
16881 c(j,i)=c(j,i)+delta
16882 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
16883 qwolan(j,i)=(q2-q1)/delta
16889 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
16890 cdummy(j,i+nres)=c(j,i+nres)
16891 c(j,i+nres)=c(j,i+nres)+delta
16892 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
16893 qwolxan(j,i)=(q2-q1)/delta
16894 c(j,i+nres)=cdummy(j,i+nres)
16897 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
16899 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
16901 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
16903 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
16906 end subroutine qwol_num
16907 !-----------------------------------------------------------------------------
16908 subroutine EconstrQ
16909 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
16910 ! implicit real*8 (a-h,o-z)
16911 ! include 'DIMENSIONS'
16912 ! include 'COMMON.CONTROL'
16913 ! include 'COMMON.VAR'
16914 ! include 'COMMON.MD'
16917 ! include 'COMMON.LANGEVIN'
16919 ! include 'COMMON.LANGEVIN.lang0'
16921 ! include 'COMMON.CHAIN'
16922 ! include 'COMMON.DERIV'
16923 ! include 'COMMON.GEO'
16924 ! include 'COMMON.LOCAL'
16925 ! include 'COMMON.INTERACT'
16926 ! include 'COMMON.IOUNITS'
16927 ! include 'COMMON.NAMES'
16928 ! include 'COMMON.TIME1'
16929 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
16930 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
16932 integer :: kstart,kend,lstart,lend,idummy
16933 real(kind=8) :: delta=1.0d-7
16934 integer :: i,j,k,ii
16938 dudconst(j,i)=0.0d0
16939 duxconst(j,i)=0.0d0
16940 dudxconst(j,i)=0.0d0
16945 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
16947 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
16948 ! Calculating the derivatives of Constraint energy with respect to Q
16949 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
16951 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
16952 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
16953 ! hmnum=(hm2-hm1)/delta
16954 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
16955 ! & qinfrag(i,iset))
16956 ! write(iout,*) "harmonicnum frag", hmnum
16957 ! Calculating the derivatives of Q with respect to cartesian coordinates
16958 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
16960 ! write(iout,*) "dqwol "
16962 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
16964 ! write(iout,*) "dxqwol "
16966 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
16968 ! Calculating numerical gradients of dU/dQi and dQi/dxi
16969 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
16970 ! & ,idummy,idummy)
16971 ! The gradients of Uconst in Cs
16974 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
16975 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
16980 kstart=ifrag(1,ipair(1,i,iset),iset)
16981 kend=ifrag(2,ipair(1,i,iset),iset)
16982 lstart=ifrag(1,ipair(2,i,iset),iset)
16983 lend=ifrag(2,ipair(2,i,iset),iset)
16984 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
16985 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
16986 ! Calculating dU/dQ
16987 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
16988 ! hm1=harmonic(qpair(i),qinpair(i,iset))
16989 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
16990 ! hmnum=(hm2-hm1)/delta
16991 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
16992 ! & qinpair(i,iset))
16993 ! write(iout,*) "harmonicnum pair ", hmnum
16994 ! Calculating dQ/dXi
16995 call qwolynes_prim(kstart,kend,.false.,&
16997 ! write(iout,*) "dqwol "
16999 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17001 ! write(iout,*) "dxqwol "
17003 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17005 ! Calculating numerical gradients
17006 ! call qwol_num(kstart,kend,.false.
17008 ! The gradients of Uconst in Cs
17011 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
17012 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
17016 ! write(iout,*) "Uconst inside subroutine ", Uconst
17017 ! Transforming the gradients from Cs to dCs for the backbone
17021 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
17025 ! Transforming the gradients from Cs to dCs for the side chains
17028 dudxconst(j,i)=duxconst(j,i)
17031 ! write(iout,*) "dU/ddc backbone "
17033 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
17035 ! write(iout,*) "dU/ddX side chain "
17037 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
17039 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
17040 ! call dEconstrQ_num
17042 end subroutine EconstrQ
17043 !-----------------------------------------------------------------------------
17044 subroutine dEconstrQ_num
17045 ! Calculating numerical dUconst/ddc and dUconst/ddx
17046 ! implicit real*8 (a-h,o-z)
17047 ! include 'DIMENSIONS'
17048 ! include 'COMMON.CONTROL'
17049 ! include 'COMMON.VAR'
17050 ! include 'COMMON.MD'
17053 ! include 'COMMON.LANGEVIN'
17055 ! include 'COMMON.LANGEVIN.lang0'
17057 ! include 'COMMON.CHAIN'
17058 ! include 'COMMON.DERIV'
17059 ! include 'COMMON.GEO'
17060 ! include 'COMMON.LOCAL'
17061 ! include 'COMMON.INTERACT'
17062 ! include 'COMMON.IOUNITS'
17063 ! include 'COMMON.NAMES'
17064 ! include 'COMMON.TIME1'
17065 real(kind=8) :: uzap1,uzap2
17066 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
17067 integer :: kstart,kend,lstart,lend,idummy
17068 real(kind=8) :: delta=1.0d-7
17069 !el local variables
17075 dUcartan(j,i)=0.0d0
17076 cdummy(j,i)=dc(j,i)
17077 dc(j,i)=dc(j,i)+delta
17078 call chainbuild_cart
17081 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17083 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17087 kstart=ifrag(1,ipair(1,ii,iset),iset)
17088 kend=ifrag(2,ipair(1,ii,iset),iset)
17089 lstart=ifrag(1,ipair(2,ii,iset),iset)
17090 lend=ifrag(2,ipair(2,ii,iset),iset)
17091 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17092 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17095 dc(j,i)=cdummy(j,i)
17096 call chainbuild_cart
17099 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17101 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17105 kstart=ifrag(1,ipair(1,ii,iset),iset)
17106 kend=ifrag(2,ipair(1,ii,iset),iset)
17107 lstart=ifrag(1,ipair(2,ii,iset),iset)
17108 lend=ifrag(2,ipair(2,ii,iset),iset)
17109 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17110 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17113 ducartan(j,i)=(uzap2-uzap1)/(delta)
17116 ! Calculating numerical gradients for dU/ddx
17118 duxcartan(j,i)=0.0d0
17120 cdummy(j,i)=dc(j,i+nres)
17121 dc(j,i+nres)=dc(j,i+nres)+delta
17122 call chainbuild_cart
17125 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17127 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17131 kstart=ifrag(1,ipair(1,ii,iset),iset)
17132 kend=ifrag(2,ipair(1,ii,iset),iset)
17133 lstart=ifrag(1,ipair(2,ii,iset),iset)
17134 lend=ifrag(2,ipair(2,ii,iset),iset)
17135 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17136 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17139 dc(j,i+nres)=cdummy(j,i)
17140 call chainbuild_cart
17143 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
17144 ifrag(2,ii,iset),.true.,idummy,idummy)
17145 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17149 kstart=ifrag(1,ipair(1,ii,iset),iset)
17150 kend=ifrag(2,ipair(1,ii,iset),iset)
17151 lstart=ifrag(1,ipair(2,ii,iset),iset)
17152 lend=ifrag(2,ipair(2,ii,iset),iset)
17153 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17154 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17157 duxcartan(j,i)=(uzap2-uzap1)/(delta)
17160 write(iout,*) "Numerical dUconst/ddc backbone "
17162 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
17164 ! write(iout,*) "Numerical dUconst/ddx side-chain "
17166 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
17169 end subroutine dEconstrQ_num
17170 !-----------------------------------------------------------------------------
17172 !-----------------------------------------------------------------------------
17173 subroutine check_energies
17175 ! use random, only: ran_number
17179 ! include 'DIMENSIONS'
17180 ! include 'COMMON.CHAIN'
17181 ! include 'COMMON.VAR'
17182 ! include 'COMMON.IOUNITS'
17183 ! include 'COMMON.SBRIDGE'
17184 ! include 'COMMON.LOCAL'
17185 ! include 'COMMON.GEO'
17187 ! External functions
17188 !EL double precision ran_number
17189 !EL external ran_number
17192 integer :: i,j,k,l,lmax,p,pmax
17193 real(kind=8) :: rmin,rmax
17194 real(kind=8) :: eij
17197 real(kind=8) :: wi,rij,tj,pj
17219 !t wi=ran_number(0.0D0,pi)
17220 ! wi=ran_number(0.0D0,pi/6.0D0)
17222 !t tj=ran_number(0.0D0,pi)
17223 !t pj=ran_number(0.0D0,pi)
17224 ! pj=ran_number(0.0D0,pi/6.0D0)
17228 !t rij=ran_number(rmin,rmax)
17230 c(1,j)=d*sin(pj)*cos(tj)
17231 c(2,j)=d*sin(pj)*sin(tj)
17237 c(3,i)=-rij-d*cos(wi)
17240 dc(k,nres+i)=c(k,nres+i)-c(k,i)
17241 dc_norm(k,nres+i)=dc(k,nres+i)/d
17242 dc(k,nres+j)=c(k,nres+j)-c(k,j)
17243 dc_norm(k,nres+j)=dc(k,nres+j)/d
17246 call dyn_ssbond_ene(i,j,eij)
17251 end subroutine check_energies
17252 !-----------------------------------------------------------------------------
17253 subroutine dyn_ssbond_ene(resi,resj,eij)
17258 ! include 'DIMENSIONS'
17259 ! include 'COMMON.SBRIDGE'
17260 ! include 'COMMON.CHAIN'
17261 ! include 'COMMON.DERIV'
17262 ! include 'COMMON.LOCAL'
17263 ! include 'COMMON.INTERACT'
17264 ! include 'COMMON.VAR'
17265 ! include 'COMMON.IOUNITS'
17266 ! include 'COMMON.CALC'
17270 ! include 'COMMON.MD'
17271 ! use MD, only: totT,t_bath
17274 ! External functions
17275 !EL double precision h_base
17276 !EL external h_base
17279 integer :: resi,resj
17282 real(kind=8) :: eij
17285 logical :: havebond
17286 integer itypi,itypj
17287 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
17288 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
17289 real(kind=8),dimension(3) :: dcosom1,dcosom2
17291 real(kind=8) :: pom1,pom2
17292 real(kind=8) :: ljA,ljB,ljXs
17293 real(kind=8),dimension(1:3) :: d_ljB
17294 real(kind=8) :: ssA,ssB,ssC,ssXs
17295 real(kind=8) :: ssxm,ljxm,ssm,ljm
17296 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
17297 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
17298 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
17299 !-------FIRST METHOD
17301 real(kind=8),dimension(1:3) :: d_xm
17302 !-------END FIRST METHOD
17303 !-------SECOND METHOD
17304 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
17305 !-------END SECOND METHOD
17307 !-------TESTING CODE
17308 !el logical :: checkstop,transgrad
17309 !el common /sschecks/ checkstop,transgrad
17311 integer :: icheck,nicheck,jcheck,njcheck
17312 real(kind=8),dimension(-1:1) :: echeck
17313 real(kind=8) :: deps,ssx0,ljx0
17314 !-------END TESTING CODE
17320 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
17321 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
17324 dxi=dc_norm(1,nres+i)
17325 dyi=dc_norm(2,nres+i)
17326 dzi=dc_norm(3,nres+i)
17327 dsci_inv=vbld_inv(i+nres)
17330 xj=c(1,nres+j)-c(1,nres+i)
17331 yj=c(2,nres+j)-c(2,nres+i)
17332 zj=c(3,nres+j)-c(3,nres+i)
17333 dxj=dc_norm(1,nres+j)
17334 dyj=dc_norm(2,nres+j)
17335 dzj=dc_norm(3,nres+j)
17336 dscj_inv=vbld_inv(j+nres)
17338 chi1=chi(itypi,itypj)
17339 chi2=chi(itypj,itypi)
17346 alf12=0.5D0*(alf1+alf2)
17348 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
17349 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
17350 ! The following are set in sc_angular
17354 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
17355 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
17356 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
17358 rij=1.0D0/rij ! Reset this so it makes sense
17360 sig0ij=sigma(itypi,itypj)
17361 sig=sig0ij*dsqrt(1.0D0/sigsq)
17364 ljA=eps1*eps2rt**2*eps3rt**2
17365 ljB=ljA*bb_aq(itypi,itypj)
17366 ljA=ljA*aa_aq(itypi,itypj)
17367 ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
17372 deltat12=om2-om1+2.0d0
17373 cosphi=om12-om1*om2
17377 +akth*(deltat1*deltat1+deltat2*deltat2) &
17378 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
17379 ssxm=ssXs-0.5D0*ssB/ssA
17381 !-------TESTING CODE
17382 !$$$c Some extra output
17383 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17384 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
17385 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
17386 !$$$ if (ssx0.gt.0.0d0) then
17387 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
17391 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
17392 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
17393 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
17395 !-------END TESTING CODE
17397 !-------TESTING CODE
17398 ! Stop and plot energy and derivative as a function of distance
17399 if (checkstop) then
17400 ssm=ssC-0.25D0*ssB*ssB/ssA
17401 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17402 if (ssm.lt.ljm .and. &
17403 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
17411 if (.not.checkstop) then
17416 do icheck=0,nicheck
17417 do jcheck=-1,njcheck
17418 if (checkstop) rij=(ssxm-1.0d0)+ &
17419 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
17420 !-------END TESTING CODE
17422 if (rij.gt.ljxm) then
17425 fac=(1.0D0/ljd)**expon
17426 e1=fac*fac*aa_aq(itypi,itypj)
17427 e2=fac*bb_aq(itypi,itypj)
17428 eij=eps1*eps2rt*eps3rt*(e1+e2)
17431 eij=eij*eps2rt*eps3rt
17434 e1=e1*eps1*eps2rt**2*eps3rt**2
17435 ed=-expon*(e1+eij)/ljd
17437 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
17438 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
17439 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
17440 -2.0D0*alf12*eps3der+sigder*sigsq_om12
17441 else if (rij.lt.ssxm) then
17444 eij=ssA*ssd*ssd+ssB*ssd+ssC
17446 ed=2*akcm*ssd+akct*deltat12
17448 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
17449 eom1=-2*akth*deltat1-pom1-om2*pom2
17450 eom2= 2*akth*deltat2+pom1-om1*pom2
17453 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
17455 d_ssxm(1)=0.5D0*akct/ssA
17456 d_ssxm(2)=-d_ssxm(1)
17459 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
17460 d_ljxm(2)=d_ljxm(1)*sigsq_om2
17461 d_ljxm(3)=d_ljxm(1)*sigsq_om12
17462 d_ljxm(1)=d_ljxm(1)*sigsq_om1
17464 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
17465 xm=0.5d0*(ssxm+ljxm)
17467 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
17469 if (rij.lt.xm) then
17471 ssm=ssC-0.25D0*ssB*ssB/ssA
17472 d_ssm(1)=0.5D0*akct*ssB/ssA
17473 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
17474 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
17476 f1=(rij-xm)/(ssxm-xm)
17477 f2=(rij-ssxm)/(xm-ssxm)
17481 delta_inv=1.0d0/(xm-ssxm)
17482 deltasq_inv=delta_inv*delta_inv
17484 fac1=deltasq_inv*fac*(xm-rij)
17485 fac2=deltasq_inv*fac*(rij-ssxm)
17486 ed=delta_inv*(Ht*hd2-ssm*hd1)
17487 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
17488 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
17489 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
17492 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17493 d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
17494 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
17495 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
17497 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
17498 f1=(rij-ljxm)/(xm-ljxm)
17499 f2=(rij-xm)/(ljxm-xm)
17503 delta_inv=1.0d0/(ljxm-xm)
17504 deltasq_inv=delta_inv*delta_inv
17506 fac1=deltasq_inv*fac*(ljxm-rij)
17507 fac2=deltasq_inv*fac*(rij-xm)
17508 ed=delta_inv*(ljm*hd2-Ht*hd1)
17509 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
17510 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
17511 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
17513 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
17515 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
17521 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
17522 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
17523 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
17525 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17526 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
17527 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
17528 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
17529 !$$$ d_ssm(3)=omega
17531 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
17533 !$$$ d_ljm(k)=ljm*d_ljB(k)
17537 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
17538 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
17539 !$$$ d_ss(2)=akct*ssd
17540 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
17541 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
17544 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
17545 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
17546 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
17548 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
17549 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
17551 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
17553 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
17554 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
17555 !$$$ h1=h_base(f1,hd1)
17556 !$$$ h2=h_base(f2,hd2)
17557 !$$$ eij=ss*h1+ljf*h2
17558 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
17559 !$$$ deltasq_inv=delta_inv*delta_inv
17560 !$$$ fac=ljf*hd2-ss*hd1
17561 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
17562 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
17563 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
17564 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
17565 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
17566 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
17567 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
17569 !$$$ havebond=.false.
17570 !$$$ if (ed.gt.0.0d0) havebond=.true.
17571 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
17578 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
17579 ! write(iout,'(a15,f12.2,f8.1,2i5)')
17580 ! & "SSBOND_E_FORM",totT,t_bath,i,j
17584 dyn_ssbond_ij(i,j)=eij
17585 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
17586 dyn_ssbond_ij(i,j)=1.0d300
17589 ! write(iout,'(a15,f12.2,f8.1,2i5)')
17590 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
17595 !-------TESTING CODE
17596 !el if (checkstop) then
17597 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
17598 "CHECKSTOP",rij,eij,ed
17602 if (checkstop) then
17603 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
17606 if (checkstop) then
17610 !-------END TESTING CODE
17613 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
17614 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
17617 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
17620 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
17621 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
17622 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
17623 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
17624 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
17625 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
17629 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
17634 gvdwc(l,i)=gvdwc(l,i)-gg(l)
17635 gvdwc(l,j)=gvdwc(l,j)+gg(l)
17639 end subroutine dyn_ssbond_ene
17640 !-----------------------------------------------------------------------------
17641 real(kind=8) function h_base(x,deriv)
17642 ! A smooth function going 0->1 in range [0,1]
17643 ! It should NOT be called outside range [0,1], it will not work there.
17650 real(kind=8) :: deriv
17653 real(kind=8) :: xsq
17656 ! Two parabolas put together. First derivative zero at extrema
17657 !$$$ if (x.lt.0.5D0) then
17658 !$$$ h_base=2.0D0*x*x
17662 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
17663 !$$$ deriv=4.0D0*deriv
17666 ! Third degree polynomial. First derivative zero at extrema
17667 h_base=x*x*(3.0d0-2.0d0*x)
17668 deriv=6.0d0*x*(1.0d0-x)
17670 ! Fifth degree polynomial. First and second derivatives zero at extrema
17672 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
17674 !$$$ deriv=deriv*deriv
17675 !$$$ deriv=30.0d0*xsq*deriv
17678 end function h_base
17679 !-----------------------------------------------------------------------------
17680 subroutine dyn_set_nss
17681 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
17683 use MD_data, only: totT,t_bath
17685 ! include 'DIMENSIONS'
17689 ! include 'COMMON.SBRIDGE'
17690 ! include 'COMMON.CHAIN'
17691 ! include 'COMMON.IOUNITS'
17692 ! include 'COMMON.SETUP'
17693 ! include 'COMMON.MD'
17695 real(kind=8) :: emin
17696 integer :: i,j,imin,ierr
17697 integer :: diff,allnss,newnss
17698 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
17701 integer,dimension(0:nfgtasks) :: i_newnss
17702 integer,dimension(0:nfgtasks) :: displ
17703 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
17704 integer :: g_newnss
17709 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
17718 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
17722 if (allflag(i).eq.0 .and. &
17723 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
17724 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
17728 if (emin.lt.1.0d300) then
17731 if (allflag(i).eq.0 .and. &
17732 (allihpb(i).eq.allihpb(imin) .or. &
17733 alljhpb(i).eq.allihpb(imin) .or. &
17734 allihpb(i).eq.alljhpb(imin) .or. &
17735 alljhpb(i).eq.alljhpb(imin))) then
17742 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
17746 if (allflag(i).eq.1) then
17748 newihpb(newnss)=allihpb(i)
17749 newjhpb(newnss)=alljhpb(i)
17754 if (nfgtasks.gt.1)then
17756 call MPI_Reduce(newnss,g_newnss,1,&
17757 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
17758 call MPI_Gather(newnss,1,MPI_INTEGER,&
17759 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
17761 do i=1,nfgtasks-1,1
17762 displ(i)=i_newnss(i-1)+displ(i-1)
17764 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
17765 g_newihpb,i_newnss,displ,MPI_INTEGER,&
17767 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
17768 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
17770 if(fg_rank.eq.0) then
17771 ! print *,'g_newnss',g_newnss
17772 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
17773 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
17776 newihpb(i)=g_newihpb(i)
17777 newjhpb(i)=g_newjhpb(i)
17785 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
17790 if (idssb(i).eq.newihpb(j) .and. &
17791 jdssb(i).eq.newjhpb(j)) found=.true.
17795 if (.not.found.and.fg_rank.eq.0) &
17796 write(iout,'(a15,f12.2,f8.1,2i5)') &
17797 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
17805 if (newihpb(i).eq.idssb(j) .and. &
17806 newjhpb(i).eq.jdssb(j)) found=.true.
17810 if (.not.found.and.fg_rank.eq.0) &
17811 write(iout,'(a15,f12.2,f8.1,2i5)') &
17812 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
17819 idssb(i)=newihpb(i)
17820 jdssb(i)=newjhpb(i)
17824 end subroutine dyn_set_nss
17825 ! Lipid transfer energy function
17826 subroutine Eliptransfer(eliptran)
17827 !C this is done by Adasko
17828 !C print *,"wchodze"
17829 !C structure of box:
17831 !C--bordliptop-- buffore starts
17832 !C--bufliptop--- here true lipid starts
17834 !C--buflipbot--- lipid ends buffore starts
17835 !C--bordlipbot--buffore ends
17836 real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
17839 print *, "I am in eliptran"
17840 do i=ilip_start,ilip_end
17842 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1).or.(i.eq.nres))&
17845 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
17846 if (positi.le.0.0) positi=positi+boxzsize
17848 !C first for peptide groups
17849 !c for each residue check if it is in lipid or lipid water border area
17850 if ((positi.gt.bordlipbot) &
17851 .and.(positi.lt.bordliptop)) then
17852 !C the energy transfer exist
17853 if (positi.lt.buflipbot) then
17854 !C what fraction I am in
17856 ((positi-bordlipbot)/lipbufthick)
17857 !C lipbufthick is thickenes of lipid buffore
17858 sslip=sscalelip(fracinbuf)
17859 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
17860 eliptran=eliptran+sslip*pepliptran
17861 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
17862 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
17863 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
17865 !C print *,"doing sccale for lower part"
17866 !C print *,i,sslip,fracinbuf,ssgradlip
17867 elseif (positi.gt.bufliptop) then
17868 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
17869 sslip=sscalelip(fracinbuf)
17870 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
17871 eliptran=eliptran+sslip*pepliptran
17872 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
17873 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
17874 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
17875 !C print *, "doing sscalefor top part"
17876 !C print *,i,sslip,fracinbuf,ssgradlip
17878 eliptran=eliptran+pepliptran
17879 !C print *,"I am in true lipid"
17882 !C eliptran=elpitran+0.0 ! I am in water
17884 if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
17886 ! here starts the side chain transfer
17887 do i=ilip_start,ilip_end
17888 if (itype(i).eq.ntyp1) cycle
17889 positi=(mod(c(3,i+nres),boxzsize))
17890 if (positi.le.0) positi=positi+boxzsize
17891 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
17892 !c for each residue check if it is in lipid or lipid water border area
17893 !C respos=mod(c(3,i+nres),boxzsize)
17894 !C print *,positi,bordlipbot,buflipbot
17895 if ((positi.gt.bordlipbot) &
17896 .and.(positi.lt.bordliptop)) then
17897 !C the energy transfer exist
17898 if (positi.lt.buflipbot) then
17900 ((positi-bordlipbot)/lipbufthick)
17901 !C lipbufthick is thickenes of lipid buffore
17902 sslip=sscalelip(fracinbuf)
17903 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
17904 eliptran=eliptran+sslip*liptranene(itype(i))
17905 gliptranx(3,i)=gliptranx(3,i) &
17906 +ssgradlip*liptranene(itype(i))
17907 gliptranc(3,i-1)= gliptranc(3,i-1) &
17908 +ssgradlip*liptranene(itype(i))
17909 !C print *,"doing sccale for lower part"
17910 elseif (positi.gt.bufliptop) then
17912 ((bordliptop-positi)/lipbufthick)
17913 sslip=sscalelip(fracinbuf)
17914 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
17915 eliptran=eliptran+sslip*liptranene(itype(i))
17916 gliptranx(3,i)=gliptranx(3,i) &
17917 +ssgradlip*liptranene(itype(i))
17918 gliptranc(3,i-1)= gliptranc(3,i-1) &
17919 +ssgradlip*liptranene(itype(i))
17920 !C print *, "doing sscalefor top part",sslip,fracinbuf
17922 eliptran=eliptran+liptranene(itype(i))
17923 !C print *,"I am in true lipid"
17925 endif ! if in lipid or buffor
17927 !C eliptran=elpitran+0.0 ! I am in water
17928 if (energy_dec) write(iout,*) i,"eliptran=",eliptran
17931 end subroutine Eliptransfer
17932 !----------------------------------NANO FUNCTIONS
17933 !C-----------------------------------------------------------------------
17934 !C-----------------------------------------------------------
17935 !C This subroutine is to mimic the histone like structure but as well can be
17936 !C utilizet to nanostructures (infinit) small modification has to be used to
17937 !C make it finite (z gradient at the ends has to be changes as well as the x,y
17938 !C gradient has to be modified at the ends
17939 !C The energy function is Kihara potential
17940 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
17941 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
17942 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
17943 !C simple Kihara potential
17944 subroutine calctube(Etube)
17945 real(kind=8) :: vectube(3),enetube(nres*2)
17946 real(kind=8) :: Etube,xtemp,xminact,yminact,&
17947 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
17948 sc_aa_tube,sc_bb_tube
17951 do i=itube_start,itube_end
17953 enetube(i+nres)=0.0d0
17955 !C first we calculate the distance from tube center
17957 do i=itube_start,itube_end
17958 !C lets ommit dummy atoms for now
17959 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
17960 !C now calculate distance from center of tube and direction vectors
17963 ! Find minimum distance in periodic box
17965 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
17966 vectube(1)=vectube(1)+boxxsize*j
17967 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
17968 vectube(2)=vectube(2)+boxysize*j
17969 xminact=abs(vectube(1)-tubecenter(1))
17970 yminact=abs(vectube(2)-tubecenter(2))
17971 if (xmin.gt.xminact) then
17975 if (ymin.gt.yminact) then
17982 vectube(1)=vectube(1)-tubecenter(1)
17983 vectube(2)=vectube(2)-tubecenter(2)
17985 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
17986 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
17988 !C as the tube is infinity we do not calculate the Z-vector use of Z
17991 !C now calculte the distance
17992 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
17993 !C now normalize vector
17994 vectube(1)=vectube(1)/tub_r
17995 vectube(2)=vectube(2)/tub_r
17996 !C calculte rdiffrence between r and r0
17999 rdiff6=rdiff**6.0d0
18000 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18001 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
18002 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18003 !C print *,rdiff,rdiff6,pep_aa_tube
18004 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18005 !C now we calculate gradient
18006 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18007 6.0d0*pep_bb_tube)/rdiff6/rdiff
18008 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18010 !C now direction of gg_tube vector
18012 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18013 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18016 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18017 !C print *,gg_tube(1,0),"TU"
18020 do i=itube_start,itube_end
18021 !C Lets not jump over memory as we use many times iti
18023 !C lets ommit dummy atoms for now
18024 if ((iti.eq.ntyp1) &
18025 !C in UNRES uncomment the line below as GLY has no side-chain...
18031 vectube(1)=mod((c(1,i+nres)),boxxsize)
18032 vectube(1)=vectube(1)+boxxsize*j
18033 vectube(2)=mod((c(2,i+nres)),boxysize)
18034 vectube(2)=vectube(2)+boxysize*j
18036 xminact=abs(vectube(1)-tubecenter(1))
18037 yminact=abs(vectube(2)-tubecenter(2))
18038 if (xmin.gt.xminact) then
18042 if (ymin.gt.yminact) then
18049 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
18051 vectube(1)=vectube(1)-tubecenter(1)
18052 vectube(2)=vectube(2)-tubecenter(2)
18054 !C as the tube is infinity we do not calculate the Z-vector use of Z
18057 !C now calculte the distance
18058 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18059 !C now normalize vector
18060 vectube(1)=vectube(1)/tub_r
18061 vectube(2)=vectube(2)/tub_r
18063 !C calculte rdiffrence between r and r0
18066 rdiff6=rdiff**6.0d0
18067 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18068 sc_aa_tube=sc_aa_tube_par(iti)
18069 sc_bb_tube=sc_bb_tube_par(iti)
18070 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
18071 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
18072 6.0d0*sc_bb_tube/rdiff6/rdiff
18073 !C now direction of gg_tube vector
18075 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18076 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18079 do i=itube_start,itube_end
18080 Etube=Etube+enetube(i)+enetube(i+nres)
18082 !C print *,"ETUBE", etube
18084 end subroutine calctube
18085 !C TO DO 1) add to total energy
18086 !C 2) add to gradient summation
18087 !C 3) add reading parameters (AND of course oppening of PARAM file)
18088 !C 4) add reading the center of tube
18090 !C 6) add to zerograd
18091 !C 7) allocate matrices
18094 !C-----------------------------------------------------------------------
18095 !C-----------------------------------------------------------
18096 !C This subroutine is to mimic the histone like structure but as well can be
18097 !C utilizet to nanostructures (infinit) small modification has to be used to
18098 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18099 !C gradient has to be modified at the ends
18100 !C The energy function is Kihara potential
18101 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18102 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18103 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18104 !C simple Kihara potential
18105 subroutine calctube2(Etube)
18106 real(kind=8) :: vectube(3),enetube(nres*2)
18107 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18108 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
18109 sstube,ssgradtube,sc_aa_tube,sc_bb_tube
18112 do i=itube_start,itube_end
18114 enetube(i+nres)=0.0d0
18116 !C first we calculate the distance from tube center
18117 !C first sugare-phosphate group for NARES this would be peptide group
18119 do i=itube_start,itube_end
18120 !C lets ommit dummy atoms for now
18122 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
18123 !C now calculate distance from center of tube and direction vectors
18124 !C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18125 !C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18126 !C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18127 !C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18131 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18132 vectube(1)=vectube(1)+boxxsize*j
18133 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18134 vectube(2)=vectube(2)+boxysize*j
18136 xminact=abs(vectube(1)-tubecenter(1))
18137 yminact=abs(vectube(2)-tubecenter(2))
18138 if (xmin.gt.xminact) then
18142 if (ymin.gt.yminact) then
18149 vectube(1)=vectube(1)-tubecenter(1)
18150 vectube(2)=vectube(2)-tubecenter(2)
18152 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18153 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18155 !C as the tube is infinity we do not calculate the Z-vector use of Z
18158 !C now calculte the distance
18159 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18160 !C now normalize vector
18161 vectube(1)=vectube(1)/tub_r
18162 vectube(2)=vectube(2)/tub_r
18163 !C calculte rdiffrence between r and r0
18166 rdiff6=rdiff**6.0d0
18167 !C THIS FRAGMENT MAKES TUBE FINITE
18168 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
18169 if (positi.le.0) positi=positi+boxzsize
18170 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18171 !c for each residue check if it is in lipid or lipid water border area
18172 !C respos=mod(c(3,i+nres),boxzsize)
18173 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18174 if ((positi.gt.bordtubebot) &
18175 .and.(positi.lt.bordtubetop)) then
18176 !C the energy transfer exist
18177 if (positi.lt.buftubebot) then
18179 ((positi-bordtubebot)/tubebufthick)
18180 !C lipbufthick is thickenes of lipid buffore
18181 sstube=sscalelip(fracinbuf)
18182 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
18183 !C print *,ssgradtube, sstube,tubetranene(itype(i))
18184 enetube(i)=enetube(i)+sstube*tubetranenepep
18185 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18186 !C &+ssgradtube*tubetranene(itype(i))
18187 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18188 !C &+ssgradtube*tubetranene(itype(i))
18189 !C print *,"doing sccale for lower part"
18190 elseif (positi.gt.buftubetop) then
18192 ((bordtubetop-positi)/tubebufthick)
18193 sstube=sscalelip(fracinbuf)
18194 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
18195 enetube(i)=enetube(i)+sstube*tubetranenepep
18196 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18197 !C &+ssgradtube*tubetranene(itype(i))
18198 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18199 !C &+ssgradtube*tubetranene(itype(i))
18200 !C print *, "doing sscalefor top part",sslip,fracinbuf
18204 enetube(i)=enetube(i)+sstube*tubetranenepep
18205 !C print *,"I am in true lipid"
18209 !C ssgradtube=0.0d0
18211 endif ! if in lipid or buffor
18213 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18214 enetube(i)=enetube(i)+sstube* &
18215 (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
18216 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18217 !C print *,rdiff,rdiff6,pep_aa_tube
18218 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18219 !C now we calculate gradient
18220 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18221 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
18222 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18225 !C now direction of gg_tube vector
18227 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18228 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18230 gg_tube(3,i)=gg_tube(3,i) &
18231 +ssgradtube*enetube(i)/sstube/2.0d0
18232 gg_tube(3,i-1)= gg_tube(3,i-1) &
18233 +ssgradtube*enetube(i)/sstube/2.0d0
18236 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18237 !C print *,gg_tube(1,0),"TU"
18238 do i=itube_start,itube_end
18239 !C Lets not jump over memory as we use many times iti
18241 !C lets ommit dummy atoms for now
18242 if ((iti.eq.ntyp1) &
18243 !!C in UNRES uncomment the line below as GLY has no side-chain...
18246 vectube(1)=c(1,i+nres)
18247 vectube(1)=mod(vectube(1),boxxsize)
18248 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18249 vectube(2)=c(2,i+nres)
18250 vectube(2)=mod(vectube(2),boxysize)
18251 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18253 vectube(1)=vectube(1)-tubecenter(1)
18254 vectube(2)=vectube(2)-tubecenter(2)
18255 !C THIS FRAGMENT MAKES TUBE FINITE
18256 positi=(mod(c(3,i+nres),boxzsize))
18257 if (positi.le.0) positi=positi+boxzsize
18258 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18259 !c for each residue check if it is in lipid or lipid water border area
18260 !C respos=mod(c(3,i+nres),boxzsize)
18261 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18263 if ((positi.gt.bordtubebot) &
18264 .and.(positi.lt.bordtubetop)) then
18265 !C the energy transfer exist
18266 if (positi.lt.buftubebot) then
18268 ((positi-bordtubebot)/tubebufthick)
18269 !C lipbufthick is thickenes of lipid buffore
18270 sstube=sscalelip(fracinbuf)
18271 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
18272 !C print *,ssgradtube, sstube,tubetranene(itype(i))
18273 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
18274 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18275 !C &+ssgradtube*tubetranene(itype(i))
18276 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18277 !C &+ssgradtube*tubetranene(itype(i))
18278 !C print *,"doing sccale for lower part"
18279 elseif (positi.gt.buftubetop) then
18281 ((bordtubetop-positi)/tubebufthick)
18283 sstube=sscalelip(fracinbuf)
18284 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
18285 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
18286 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18287 !C &+ssgradtube*tubetranene(itype(i))
18288 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18289 !C &+ssgradtube*tubetranene(itype(i))
18290 !C print *, "doing sscalefor top part",sslip,fracinbuf
18294 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
18295 !C print *,"I am in true lipid"
18299 !C ssgradtube=0.0d0
18301 endif ! if in lipid or buffor
18302 !CEND OF FINITE FRAGMENT
18303 !C as the tube is infinity we do not calculate the Z-vector use of Z
18306 !C now calculte the distance
18307 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18308 !C now normalize vector
18309 vectube(1)=vectube(1)/tub_r
18310 vectube(2)=vectube(2)/tub_r
18311 !C calculte rdiffrence between r and r0
18314 rdiff6=rdiff**6.0d0
18315 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18316 sc_aa_tube=sc_aa_tube_par(iti)
18317 sc_bb_tube=sc_bb_tube_par(iti)
18318 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
18319 *sstube+enetube(i+nres)
18320 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18321 !C now we calculate gradient
18322 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
18323 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
18324 !C now direction of gg_tube vector
18326 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18327 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18329 gg_tube_SC(3,i)=gg_tube_SC(3,i) &
18330 +ssgradtube*enetube(i+nres)/sstube
18331 gg_tube(3,i-1)= gg_tube(3,i-1) &
18332 +ssgradtube*enetube(i+nres)/sstube
18335 do i=itube_start,itube_end
18336 Etube=Etube+enetube(i)+enetube(i+nres)
18338 !C print *,"ETUBE", etube
18340 end subroutine calctube2
18341 !=====================================================================================================================================
18342 subroutine calcnano(Etube)
18343 real(kind=8) :: vectube(3),enetube(nres*2), &
18345 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18346 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
18347 sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
18351 print *,itube_start,itube_end,"poczatek"
18352 do i=itube_start,itube_end
18354 enetube(i+nres)=0.0d0
18356 !C first we calculate the distance from tube center
18357 !C first sugare-phosphate group for NARES this would be peptide group
18359 do i=itube_start,itube_end
18360 !C lets ommit dummy atoms for now
18361 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
18362 !C now calculate distance from center of tube and direction vectors
18368 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18369 vectube(1)=vectube(1)+boxxsize*j
18370 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18371 vectube(2)=vectube(2)+boxysize*j
18372 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
18373 vectube(3)=vectube(3)+boxzsize*j
18376 xminact=dabs(vectube(1)-tubecenter(1))
18377 yminact=dabs(vectube(2)-tubecenter(2))
18378 zminact=dabs(vectube(3)-tubecenter(3))
18380 if (xmin.gt.xminact) then
18384 if (ymin.gt.yminact) then
18388 if (zmin.gt.zminact) then
18397 vectube(1)=vectube(1)-tubecenter(1)
18398 vectube(2)=vectube(2)-tubecenter(2)
18399 vectube(3)=vectube(3)-tubecenter(3)
18401 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18402 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18403 !C as the tube is infinity we do not calculate the Z-vector use of Z
18405 !C vectube(3)=0.0d0
18406 !C now calculte the distance
18407 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18408 !C now normalize vector
18409 vectube(1)=vectube(1)/tub_r
18410 vectube(2)=vectube(2)/tub_r
18411 vectube(3)=vectube(3)/tub_r
18412 !C calculte rdiffrence between r and r0
18415 rdiff6=rdiff**6.0d0
18416 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18417 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
18418 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18419 !C print *,rdiff,rdiff6,pep_aa_tube
18420 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18421 !C now we calculate gradient
18422 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18423 6.0d0*pep_bb_tube)/rdiff6/rdiff
18424 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18426 if (acavtubpep.eq.0.0d0) then
18431 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
18433 (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
18436 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
18437 *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
18438 +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
18439 /denominator**2.0d0
18446 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18447 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18451 do i=itube_start,itube_end
18452 enecavtube(i)=0.0d0
18453 !C Lets not jump over memory as we use many times iti
18455 !C lets ommit dummy atoms for now
18456 if ((iti.eq.ntyp1) &
18457 !C in UNRES uncomment the line below as GLY has no side-chain...
18464 vectube(1)=dmod((c(1,i+nres)),boxxsize)
18465 vectube(1)=vectube(1)+boxxsize*j
18466 vectube(2)=dmod((c(2,i+nres)),boxysize)
18467 vectube(2)=vectube(2)+boxysize*j
18468 vectube(3)=dmod((c(3,i+nres)),boxzsize)
18469 vectube(3)=vectube(3)+boxzsize*j
18472 xminact=dabs(vectube(1)-tubecenter(1))
18473 yminact=dabs(vectube(2)-tubecenter(2))
18474 zminact=dabs(vectube(3)-tubecenter(3))
18476 if (xmin.gt.xminact) then
18480 if (ymin.gt.yminact) then
18484 if (zmin.gt.zminact) then
18493 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
18495 vectube(1)=vectube(1)-tubecenter(1)
18496 vectube(2)=vectube(2)-tubecenter(2)
18497 vectube(3)=vectube(3)-tubecenter(3)
18498 !C now calculte the distance
18499 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18500 !C now normalize vector
18501 vectube(1)=vectube(1)/tub_r
18502 vectube(2)=vectube(2)/tub_r
18503 vectube(3)=vectube(3)/tub_r
18505 !C calculte rdiffrence between r and r0
18508 rdiff6=rdiff**6.0d0
18509 sc_aa_tube=sc_aa_tube_par(iti)
18510 sc_bb_tube=sc_bb_tube_par(iti)
18511 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
18512 !C enetube(i+nres)=0.0d0
18513 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18514 !C now we calculate gradient
18515 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
18516 6.0d0*sc_bb_tube/rdiff6/rdiff
18518 !C now direction of gg_tube vector
18519 !C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
18520 if (acavtub(iti).eq.0.0d0) then
18522 enecavtube(i+nres)=0.0d0
18525 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
18526 enecavtube(i+nres)= &
18527 (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
18529 !C enecavtube(i)=0.0
18530 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
18531 *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
18532 +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
18533 /denominator**2.0d0
18538 !C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
18539 !C & enecavtube(i),faccav
18540 !C print *,"licz=",
18541 !C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
18542 !C print *,"finene=",enetube(i+nres)+enecavtube(i)
18544 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18545 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18551 do i=itube_start,itube_end
18552 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
18553 +enecavtube(i+nres)
18555 !C print *,"ETUBE", etube
18557 end subroutine calcnano
18559 !===============================================
18560 !--------------------------------------------------------------------------------
18561 !C first for shielding is setting of function of side-chains
18563 subroutine set_shield_fac2
18564 real(kind=8) :: div77_81=0.974996043d0, &
18565 div4_81=0.2222222222d0
18566 real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
18567 scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
18568 short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
18569 sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
18570 !C the vector between center of side_chain and peptide group
18571 real(kind=8),dimension(3) :: pep_side_long,side_calf, &
18572 pept_group,costhet_grad,cosphi_grad_long, &
18573 cosphi_grad_loc,pep_side_norm,side_calf_norm, &
18574 sh_frac_dist_grad,pep_side
18576 !C write(2,*) "ivec",ivec_start,ivec_end
18578 fac_shield(i)=0.0d0
18580 grad_shield(j,i)=0.0d0
18583 do i=ivec_start,ivec_end
18585 !C if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
18587 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
18588 !Cif there two consequtive dummy atoms there is no peptide group between them
18589 !C the line below has to be changed for FGPROC>1
18592 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
18596 !C first lets set vector conecting the ithe side-chain with kth side-chain
18597 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
18598 !C pep_side(j)=2.0d0
18599 !C and vector conecting the side-chain with its proper calfa
18600 side_calf(j)=c(j,k+nres)-c(j,k)
18601 !C side_calf(j)=2.0d0
18602 pept_group(j)=c(j,i)-c(j,i+1)
18603 !C lets have their lenght
18604 dist_pep_side=pep_side(j)**2+dist_pep_side
18605 dist_side_calf=dist_side_calf+side_calf(j)**2
18606 dist_pept_group=dist_pept_group+pept_group(j)**2
18608 dist_pep_side=sqrt(dist_pep_side)
18609 dist_pept_group=sqrt(dist_pept_group)
18610 dist_side_calf=sqrt(dist_side_calf)
18612 pep_side_norm(j)=pep_side(j)/dist_pep_side
18613 side_calf_norm(j)=dist_side_calf
18615 !C now sscale fraction
18616 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
18617 !C print *,buff_shield,"buff"
18619 if (sh_frac_dist.le.0.0) cycle
18620 !C print *,ishield_list(i),i
18621 !C If we reach here it means that this side chain reaches the shielding sphere
18622 !C Lets add him to the list for gradient
18623 ishield_list(i)=ishield_list(i)+1
18624 !C ishield_list is a list of non 0 side-chain that contribute to factor gradient
18625 !C this list is essential otherwise problem would be O3
18626 shield_list(ishield_list(i),i)=k
18627 !C Lets have the sscale value
18628 if (sh_frac_dist.gt.1.0) then
18629 scale_fac_dist=1.0d0
18631 sh_frac_dist_grad(j)=0.0d0
18634 scale_fac_dist=-sh_frac_dist*sh_frac_dist &
18635 *(2.0d0*sh_frac_dist-3.0d0)
18636 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
18637 /dist_pep_side/buff_shield*0.5d0
18639 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
18640 !C sh_frac_dist_grad(j)=0.0d0
18641 !C scale_fac_dist=1.0d0
18642 !C print *,"jestem",scale_fac_dist,fac_help_scale,
18643 !C & sh_frac_dist_grad(j)
18646 !C this is what is now we have the distance scaling now volume...
18647 short=short_r_sidechain(itype(k))
18648 long=long_r_sidechain(itype(k))
18649 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
18650 sinthet=short/dist_pep_side*costhet
18651 !C now costhet_grad
18654 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
18655 !C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
18656 !C & -short/dist_pep_side**2/costhet)
18657 !C costhet_fac=0.0d0
18659 costhet_grad(j)=costhet_fac*pep_side(j)
18661 !C remember for the final gradient multiply costhet_grad(j)
18662 !C for side_chain by factor -2 !
18663 !C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
18664 !C pep_side0pept_group is vector multiplication
18665 pep_side0pept_group=0.0d0
18667 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
18669 cosalfa=(pep_side0pept_group/ &
18670 (dist_pep_side*dist_side_calf))
18671 fac_alfa_sin=1.0d0-cosalfa**2
18672 fac_alfa_sin=dsqrt(fac_alfa_sin)
18673 rkprim=fac_alfa_sin*(long-short)+short
18676 !C now costhet_grad
18677 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
18679 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
18680 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
18684 cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
18685 +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
18686 *(long-short)/fac_alfa_sin*cosalfa/ &
18687 ((dist_pep_side*dist_side_calf))* &
18688 ((side_calf(j))-cosalfa* &
18689 ((pep_side(j)/dist_pep_side)*dist_side_calf))
18690 !C cosphi_grad_long(j)=0.0d0
18691 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
18692 *(long-short)/fac_alfa_sin*cosalfa &
18693 /((dist_pep_side*dist_side_calf))* &
18695 cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
18696 !C cosphi_grad_loc(j)=0.0d0
18698 !C print *,sinphi,sinthet
18699 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
18702 !C now the gradient...
18704 grad_shield(j,i)=grad_shield(j,i) &
18705 !C gradient po skalowaniu
18706 +(sh_frac_dist_grad(j)*VofOverlap &
18707 !C gradient po costhet
18708 +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
18709 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
18710 sinphi/sinthet*costhet*costhet_grad(j) &
18711 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
18713 !C grad_shield_side is Cbeta sidechain gradient
18714 grad_shield_side(j,ishield_list(i),i)=&
18715 (sh_frac_dist_grad(j)*-2.0d0&
18717 -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
18718 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
18719 sinphi/sinthet*costhet*costhet_grad(j)&
18720 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
18723 grad_shield_loc(j,ishield_list(i),i)= &
18724 scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
18725 (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
18726 sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
18730 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
18732 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
18734 !C write(2,*) "TOTAL VOLUME",i,itype(i),fac_shield(i)
18737 end subroutine set_shield_fac2
18739 !-----------------------------------------------------------------------------
18741 subroutine read_ssHist
18744 ! include 'DIMENSIONS'
18745 ! include "DIMENSIONS.FREE"
18746 ! include 'COMMON.FREE'
18749 character(len=80) :: controlcard
18752 call card_concat(controlcard,.true.)
18753 read(controlcard,*) &
18754 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
18758 end subroutine read_ssHist
18760 !-----------------------------------------------------------------------------
18761 integer function indmat(i,j)
18763 ! get the position of the jth ijth fragment of the chain coordinate system
18764 ! in the fromto array.
18767 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
18769 end function indmat
18770 !-----------------------------------------------------------------------------
18771 real(kind=8) function sigm(x)
18777 !-----------------------------------------------------------------------------
18778 !-----------------------------------------------------------------------------
18779 subroutine alloc_ener_arrays
18780 !EL Allocation of arrays used by module energy
18781 use MD_data, only: mset
18782 !el local variables
18785 if(nres.lt.100) then
18787 elseif(nres.lt.200) then
18788 maxconts=0.8*nres ! Max. number of contacts per residue
18790 maxconts=0.6*nres ! (maxconts=maxres/4)
18792 maxcont=12*nres ! Max. number of SC contacts
18793 maxvar=6*nres ! Max. number of variables
18794 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
18795 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
18796 !----------------------
18797 ! arrays in subroutine init_int_table
18799 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
18800 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
18802 allocate(nint_gr(nres))
18803 allocate(nscp_gr(nres))
18804 allocate(ielstart(nres))
18805 allocate(ielend(nres))
18807 allocate(istart(nres,maxint_gr))
18808 allocate(iend(nres,maxint_gr))
18809 !(maxres,maxint_gr)
18810 allocate(iscpstart(nres,maxint_gr))
18811 allocate(iscpend(nres,maxint_gr))
18812 !(maxres,maxint_gr)
18813 allocate(ielstart_vdw(nres))
18814 allocate(ielend_vdw(nres))
18817 allocate(lentyp(0:nfgtasks-1))
18819 !----------------------
18821 ! common /contacts/
18822 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
18823 allocate(icont(2,maxcont))
18825 ! common /contacts1/
18826 allocate(num_cont(0:nres+4))
18828 allocate(jcont(maxconts,nres))
18830 allocate(facont(maxconts,nres))
18832 allocate(gacont(3,maxconts,nres))
18833 !(3,maxconts,maxres)
18834 ! common /contacts_hb/
18835 allocate(gacontp_hb1(3,maxconts,nres))
18836 allocate(gacontp_hb2(3,maxconts,nres))
18837 allocate(gacontp_hb3(3,maxconts,nres))
18838 allocate(gacontm_hb1(3,maxconts,nres))
18839 allocate(gacontm_hb2(3,maxconts,nres))
18840 allocate(gacontm_hb3(3,maxconts,nres))
18841 allocate(gacont_hbr(3,maxconts,nres))
18842 allocate(grij_hb_cont(3,maxconts,nres))
18843 !(3,maxconts,maxres)
18844 allocate(facont_hb(maxconts,nres))
18846 allocate(ees0p(maxconts,nres))
18847 allocate(ees0m(maxconts,nres))
18848 allocate(d_cont(maxconts,nres))
18849 allocate(ees0plist(maxconts,nres))
18852 allocate(num_cont_hb(nres))
18854 allocate(jcont_hb(maxconts,nres))
18857 allocate(Ug(2,2,nres))
18858 allocate(Ugder(2,2,nres))
18859 allocate(Ug2(2,2,nres))
18860 allocate(Ug2der(2,2,nres))
18862 allocate(obrot(2,nres))
18863 allocate(obrot2(2,nres))
18864 allocate(obrot_der(2,nres))
18865 allocate(obrot2_der(2,nres))
18867 ! common /precomp1/
18868 allocate(mu(2,nres))
18869 allocate(muder(2,nres))
18870 allocate(Ub2(2,nres))
18873 allocate(Ub2der(2,nres))
18874 allocate(Ctobr(2,nres))
18875 allocate(Ctobrder(2,nres))
18876 allocate(Dtobr2(2,nres))
18877 allocate(Dtobr2der(2,nres))
18879 allocate(EUg(2,2,nres))
18880 allocate(EUgder(2,2,nres))
18881 allocate(CUg(2,2,nres))
18882 allocate(CUgder(2,2,nres))
18883 allocate(DUg(2,2,nres))
18884 allocate(Dugder(2,2,nres))
18885 allocate(DtUg2(2,2,nres))
18886 allocate(DtUg2der(2,2,nres))
18888 ! common /precomp2/
18889 allocate(Ug2Db1t(2,nres))
18890 allocate(Ug2Db1tder(2,nres))
18891 allocate(CUgb2(2,nres))
18892 allocate(CUgb2der(2,nres))
18894 allocate(EUgC(2,2,nres))
18895 allocate(EUgCder(2,2,nres))
18896 allocate(EUgD(2,2,nres))
18897 allocate(EUgDder(2,2,nres))
18898 allocate(DtUg2EUg(2,2,nres))
18899 allocate(Ug2DtEUg(2,2,nres))
18901 allocate(Ug2DtEUgder(2,2,2,nres))
18902 allocate(DtUg2EUgder(2,2,2,nres))
18904 ! common /rotat_old/
18905 allocate(costab(nres))
18906 allocate(sintab(nres))
18907 allocate(costab2(nres))
18908 allocate(sintab2(nres))
18911 allocate(a_chuj(2,2,maxconts,nres))
18912 !(2,2,maxconts,maxres)(maxconts=maxres/4)
18913 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
18914 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
18915 ! common /contdistrib/
18916 allocate(ncont_sent(nres))
18917 allocate(ncont_recv(nres))
18919 allocate(iat_sent(nres))
18921 allocate(iint_sent(4,nres,nres))
18922 allocate(iint_sent_local(4,nres,nres))
18924 allocate(iturn3_sent(4,0:nres+4))
18925 allocate(iturn4_sent(4,0:nres+4))
18926 allocate(iturn3_sent_local(4,nres))
18927 allocate(iturn4_sent_local(4,nres))
18929 allocate(itask_cont_from(0:nfgtasks-1))
18930 allocate(itask_cont_to(0:nfgtasks-1))
18931 !(0:max_fg_procs-1)
18935 !----------------------
18938 allocate(dcdv(6,maxdim))
18939 allocate(dxdv(6,maxdim))
18941 allocate(dxds(6,nres))
18943 allocate(gradx(3,-1:nres,0:2))
18944 allocate(gradc(3,-1:nres,0:2))
18946 allocate(gvdwx(3,-1:nres))
18947 allocate(gvdwc(3,-1:nres))
18948 allocate(gelc(3,-1:nres))
18949 allocate(gelc_long(3,-1:nres))
18950 allocate(gvdwpp(3,-1:nres))
18951 allocate(gvdwc_scpp(3,-1:nres))
18952 allocate(gradx_scp(3,-1:nres))
18953 allocate(gvdwc_scp(3,-1:nres))
18954 allocate(ghpbx(3,-1:nres))
18955 allocate(ghpbc(3,-1:nres))
18956 allocate(gradcorr(3,-1:nres))
18957 allocate(gradcorr_long(3,-1:nres))
18958 allocate(gradcorr5_long(3,-1:nres))
18959 allocate(gradcorr6_long(3,-1:nres))
18960 allocate(gcorr6_turn_long(3,-1:nres))
18961 allocate(gradxorr(3,-1:nres))
18962 allocate(gradcorr5(3,-1:nres))
18963 allocate(gradcorr6(3,-1:nres))
18964 allocate(gliptran(3,-1:nres))
18965 allocate(gliptranc(3,-1:nres))
18966 allocate(gliptranx(3,-1:nres))
18967 allocate(gshieldx(3,-1:nres))
18968 allocate(gshieldc(3,-1:nres))
18969 allocate(gshieldc_loc(3,-1:nres))
18970 allocate(gshieldx_ec(3,-1:nres))
18971 allocate(gshieldc_ec(3,-1:nres))
18972 allocate(gshieldc_loc_ec(3,-1:nres))
18973 allocate(gshieldx_t3(3,-1:nres))
18974 allocate(gshieldc_t3(3,-1:nres))
18975 allocate(gshieldc_loc_t3(3,-1:nres))
18976 allocate(gshieldx_t4(3,-1:nres))
18977 allocate(gshieldc_t4(3,-1:nres))
18978 allocate(gshieldc_loc_t4(3,-1:nres))
18979 allocate(gshieldx_ll(3,-1:nres))
18980 allocate(gshieldc_ll(3,-1:nres))
18981 allocate(gshieldc_loc_ll(3,-1:nres))
18982 allocate(grad_shield(3,-1:nres))
18983 allocate(gg_tube_sc(3,-1:nres))
18984 allocate(gg_tube(3,-1:nres))
18986 allocate(grad_shield_side(3,50,nres))
18987 allocate(grad_shield_loc(3,50,nres))
18988 ! grad for shielding surroing
18989 allocate(gloc(0:maxvar,0:2))
18990 allocate(gloc_x(0:maxvar,2))
18992 allocate(gel_loc(3,-1:nres))
18993 allocate(gel_loc_long(3,-1:nres))
18994 allocate(gcorr3_turn(3,-1:nres))
18995 allocate(gcorr4_turn(3,-1:nres))
18996 allocate(gcorr6_turn(3,-1:nres))
18997 allocate(gradb(3,-1:nres))
18998 allocate(gradbx(3,-1:nres))
19000 allocate(gel_loc_loc(maxvar))
19001 allocate(gel_loc_turn3(maxvar))
19002 allocate(gel_loc_turn4(maxvar))
19003 allocate(gel_loc_turn6(maxvar))
19004 allocate(gcorr_loc(maxvar))
19005 allocate(g_corr5_loc(maxvar))
19006 allocate(g_corr6_loc(maxvar))
19008 allocate(gsccorc(3,-1:nres))
19009 allocate(gsccorx(3,-1:nres))
19011 allocate(gsccor_loc(-1:nres))
19013 allocate(dtheta(3,2,-1:nres))
19015 allocate(gscloc(3,-1:nres))
19016 allocate(gsclocx(3,-1:nres))
19018 allocate(dphi(3,3,-1:nres))
19019 allocate(dalpha(3,3,-1:nres))
19020 allocate(domega(3,3,-1:nres))
19022 ! common /deriv_scloc/
19023 allocate(dXX_C1tab(3,nres))
19024 allocate(dYY_C1tab(3,nres))
19025 allocate(dZZ_C1tab(3,nres))
19026 allocate(dXX_Ctab(3,nres))
19027 allocate(dYY_Ctab(3,nres))
19028 allocate(dZZ_Ctab(3,nres))
19029 allocate(dXX_XYZtab(3,nres))
19030 allocate(dYY_XYZtab(3,nres))
19031 allocate(dZZ_XYZtab(3,nres))
19034 allocate(jgrad_start(nres))
19035 allocate(jgrad_end(nres))
19037 !----------------------
19040 allocate(ibond_displ(0:nfgtasks-1))
19041 allocate(ibond_count(0:nfgtasks-1))
19042 allocate(ithet_displ(0:nfgtasks-1))
19043 allocate(ithet_count(0:nfgtasks-1))
19044 allocate(iphi_displ(0:nfgtasks-1))
19045 allocate(iphi_count(0:nfgtasks-1))
19046 allocate(iphi1_displ(0:nfgtasks-1))
19047 allocate(iphi1_count(0:nfgtasks-1))
19048 allocate(ivec_displ(0:nfgtasks-1))
19049 allocate(ivec_count(0:nfgtasks-1))
19050 allocate(iset_displ(0:nfgtasks-1))
19051 allocate(iset_count(0:nfgtasks-1))
19052 allocate(iint_count(0:nfgtasks-1))
19053 allocate(iint_displ(0:nfgtasks-1))
19054 !(0:max_fg_procs-1)
19055 !----------------------
19058 allocate(gcart(3,-1:nres))
19059 allocate(gxcart(3,-1:nres))
19061 allocate(gradcag(3,-1:nres))
19062 allocate(gradxag(3,-1:nres))
19064 ! common /back_constr/
19065 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
19066 allocate(dutheta(nres))
19067 allocate(dugamma(nres))
19069 allocate(duscdiff(3,nres))
19070 allocate(duscdiffx(3,nres))
19072 !el i io:read_fragments
19073 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
19074 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
19076 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
19077 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
19078 allocate(mset(0:nprocs)) !(maxprocs/20)
19080 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
19081 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
19082 allocate(dUdconst(3,0:nres))
19083 allocate(dUdxconst(3,0:nres))
19084 allocate(dqwol(3,0:nres))
19085 allocate(dxqwol(3,0:nres))
19087 !----------------------
19089 ! common /sbridge/ in io_common: read_bridge
19090 !el allocate((:),allocatable :: iss !(maxss)
19091 ! common /links/ in io_common: read_bridge
19092 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
19093 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
19094 ! common /dyn_ssbond/
19095 ! and side-chain vectors in theta or phi.
19096 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
19100 dyn_ssbond_ij(:,:)=1.0d300
19105 allocate(idssb(nss),jdssb(nss))
19108 allocate(ishield_list(nres))
19109 allocate(shield_list(50,nres))
19110 allocate(dyn_ss_mask(nres))
19111 allocate(fac_shield(nres))
19113 dyn_ss_mask(:)=.false.
19114 !----------------------
19116 ! Parameters of the SCCOR term
19118 !el in io_conf: parmread
19119 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
19120 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
19121 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
19122 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
19123 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
19124 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
19125 ! allocate(vlor1sccor(maxterm_sccor,20,20))
19126 ! allocate(vlor2sccor(maxterm_sccor,20,20))
19127 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
19129 allocate(gloc_sc(3,0:2*nres,0:10))
19130 !(3,0:maxres2,10)maxres2=2*maxres
19131 allocate(dcostau(3,3,3,2*nres))
19132 allocate(dsintau(3,3,3,2*nres))
19133 allocate(dtauangle(3,3,3,2*nres))
19134 allocate(dcosomicron(3,3,3,2*nres))
19135 allocate(domicron(3,3,3,2*nres))
19136 !(3,3,3,maxres2)maxres2=2*maxres
19137 !----------------------
19140 allocate(varall(maxvar))
19141 !(maxvar)(maxvar=6*maxres)
19142 allocate(mask_theta(nres))
19143 allocate(mask_phi(nres))
19144 allocate(mask_side(nres))
19146 !----------------------
19149 allocate(uy(3,nres))
19150 allocate(uz(3,nres))
19152 allocate(uygrad(3,3,2,nres))
19153 allocate(uzgrad(3,3,2,nres))
19157 end subroutine alloc_ener_arrays
19158 !-----------------------------------------------------------------------------
19159 !-----------------------------------------------------------------------------